• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA oplossing nodig bij dynamic shap color

Status
Niet open voor verdere reacties.
R

resmatrix

Gebruiker
Lid geworden
6 nov 2006
Berichten
173
Goedermorgen

ik gebruik een sheen waar een stoplicht op staat.
de kleur van het licht (rood geel of groen) is afjhankelijk van een waarde in een cel
De waarde in die cel verandert afhankelijk van voor welke entiteit ik het bekijk en de cel zoekt dus middels Vlookup de entiteit op op een andere sheet en plaatst deze in de cel
Tot zover prima, echter de kleur verandert niet van de shap als de waarde in de cel verandert. Als ik hard de waarde in de cel ingeef "groen" + enter dan verandert de kleur keurig
Als hij het echter via vlookup opzoekt verandert de kleur niet

ik doe dus blijkbaar iets fout en hoop dat iemand kan helpen

onderstaand de code
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("BL3")) Is Nothing Then
 Me.Shapes("Oval 7").Select
 With Range("BL3")
 If .Value = "Green" Then
 Selection.ShapeRange.Fill.ForeColor.RGB = vbGreen
 Else
 Selection.ShapeRange.Fill.ForeColor.RGB = vbBlack
 End If
 .Select
 End With
 End If
  If Not Intersect(Target, Range("BL3")) Is Nothing Then
 Me.Shapes("Oval 6").Select
 With Range("BL3")
 If .Value = "Yellow" Then
 Selection.ShapeRange.Fill.ForeColor.RGB = vbYellow
 Else
 Selection.ShapeRange.Fill.ForeColor.RGB = vbBlack
 End If
 .Select
 End With
 End If
  If Not Intersect(Target, Range("BL3")) Is Nothing Then
 Me.Shapes("Oval 5").Select
 With Range("BL3")
 If .Value = "Red" Then
 Selection.ShapeRange.Fill.ForeColor.RGB = vbRed
 Else
 Selection.ShapeRange.Fill.ForeColor.RGB = vbBlack
 End If
 .Select
 End With
 End If
End Sub
 
je change_event doet netjes zijn werk, dat zeg je zelf ook.
Dat gebeurt niet na een aanpassing van je werkblad door formules, ook logisch

Dus moet je er een nieuw "Worksheet_Calculate"-event (dat is al formules de celinhoud veranderen) bij betrekken en daar diezelfde zaken inschrijven als in je change-macro.
Je kan anders een meer algemene macro aanmaken en die dan zowel vanuit je change als vanuit je calculate-macro aanroepen.
Verder mogen al die "select" en "selection"-zaken weg, dat is toch maar ballast.

Als je er niet uitkomt, dan post je beter een excel-bijlage, dat is, voor mij, stukken concreter en gemakkelijker dan hier wat zaken los uit de pols neer te schrijven.
 
Laatst bewerkt:
Zonder dat je een voorbeeld document hebt geplaatst lijkt me dit voldoende, naast wat cow 18 al schreef:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("BL3")) Is Nothing Then Exit Sub
    Select Case Range("BL3").Value
        Case "Green"
            Me.Shapes("Oval 5").ShapeRange.Fill.ForeColor = vbGreen
        Case "Yellow"
            Me.Shapes("Oval 6").ShapeRange.Fill.ForeColor = vbYellow
        Case "Red"
            Me.Shapes("Oval 7").ShapeRange.Fill.ForeColor = vbRed
        Case Else
            For i = 5 To 7
                Me.Shapes("Oval " & i).ShapeRange.Fill.ForeColor = vbBlack
            Next i
    End Select
End Sub

Tip:
Let ook op je inspringpunten.
 
Laatst bewerkt:
dank voor de antwoorden maar op een of andere manier krijg ik het echt niet voor elkaar

ik heb een bestand bijgevoegd wellicht dat t helpt
de waarde in cel U3 verandert dus

bij voorbaat dank
 

Bijlagen

  • voorbeeld.xlsm
    17,5 KB · Weergaven: 36
Je doet iets met een Change_event, maar gebruikt het niet in de code.
Kijk eens naar de "Intersect" regel.

Welke cel aanduiding zou hier moeten staan?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan