Avatar billede beanbag Nybegynder
08. marts 2012 - 22:18 Der er 1 løsning

VBA justering (betinget formattering af autoshapes)

Hej,
Nedenstående VBA ændrer farverne på en række autoshapes.
Men for at eksekvere koden skal jeg aktivere cellerne i kolonne L eller M og trykke enter. Det er lidt træls når der er 20 ark. Data kommer automatisk ind via links.

=> Hvordan kan jeg ændre koden så den kører samlet? F.eks når man gemmer workbook?
=> Kan jeg evt lave en "samle-makro" som kører hver sheet-makro "on demand"?

mvh
Thomas

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myShape As Shape
Dim CellA As Range
Dim CellB As Range
Dim iCtr As Long
Dim myColor As Long

With Me
For iCtr = 1 To 12
Set myShape = Nothing
Set CellA = Nothing
Set CellB = Nothing
On Error Resume Next
Set myShape = .Shapes("Box" & iCtr)
Set CellA = .Range("L" & iCtr)
Set CellB = .Range("M" & iCtr)
On Error GoTo 0

If myShape Is Nothing _
Or CellA Is Nothing _
Or CellB Is Nothing Then
MsgBox "Design error with Object/CellA/CellB " & iCtr
Else
If Intersect(Target, Union(CellA, CellB)) Is Nothing Then
'do nothing
Else
If CellA.Value > CellB.Value Then
myColor = 17
ElseIf CellA.Value = CellB.Value Then
myColor = 18
Else
myColor = 16
End If
myShape.OLEFormat.Object.ShapeRange _
.Fill.ForeColor.SchemeColor = myColor
End If
End If
Next iCtr
End With

End Sub
Avatar billede beanbag Nybegynder
24. juni 2012 - 14:37 #1
Lukker
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester