Code umschreiben

Hallo,
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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Worksheet_Change(ByVal Target As Range) Dim shp As Shape ' Schleife über alle Steuerelemente If Not Application.Intersect(Target, Range("A1:K50")) Is Nothing Then For Each shp In Me.Shapes ' Namen des Steuerelementes prüfen If shp.AutoShapeType = msoShapeOval Then ' Zelle die abgefragt werden soll If Target.Address = shp.BottomRightCell.Address Then With shp.Fill.ForeColor Select Case LCase(Target) Case "grün", "abgeschlossen", "erledigt" .SchemeColor = 11 ' grün Case "gelb", "teilweise", "in arbeit" .SchemeColor = 13 ' gelb Case "rot", "termin" .SchemeColor = 10 ' rot Case "n.a." .SchemeColor = 8 ' schwarz Case "zurückgestellt" .SchemeColor = 22 ' grau Case Else .SchemeColor = 9 ' weiß End Select End With Exit Sub End If Else shp.Fill.ForeColor.SchemeColor = 1 End If Next shp End If End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread