Code umschreiben
stef26
habe einen Code gefunden, der mir je nach Eingabe in einer Zelle das Oval (Kreis) in der entsprechenden Zeile (egal wo das OVAL steht) in einer bestimmten Farbe einfärbt.
Verwende dies um mir optisch den aktuellen Status anzeigen zu lassen.
Möchte nun in jeder Zelle (in einem Bereich von A1 bis K50) ein Oval einfügen, und je nach Zelleninhalt sollte nun das Oval in der jeweiligen Zelle gefärbt werden.
Wer kann mir da weiterhelfen ?
hier der "alte" Code...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim InI As Integer
' Schleife über alle Steuerelemente
For InI = 1 To Shapes.Count
' Namen des Steuerelementes prüfen
If Mid(Shapes(InI).Name, 1, 4) = "Oval" Then
' Zeile die abgefragt werden soll
Select Case Cells(ActiveSheet.Shapes(InI).BottomRightCell.Row, 6).Value
Case "grün"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 11 ' grün
Case "abgeschlossen"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 11 ' grün
Case "erledigt"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 11 ' grün
Case "gelb"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 13 ' gelb
Case "Teilweise"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 13 ' gelb
Case "in Arbeit"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 13 ' gelb
Case "rot"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 10 ' rot
Case "Termin"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 10 ' rot
Case "n.a."
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 8 ' schwarz
Case "zurückgestellt"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 22 ' grau
Case Else
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 9 ' weiß
End Select
Else
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 1
End If
Next InI
End Sub