Code auf Zellbezug anpasse
06.01.2020 08:39:18
Wolfgang
den nachfolgenden Code erhielt ich dankenswerter Weise hier aus dem Forum. Es wird dabei Bezug auf -aktuell- 15 Grafiken im Tabellenblatt Sachstand genommen. Wäre denkbar, den Code anzupassen und den Bezug auf die 15 Grafiken (For i = 1 To 15) in einer Zelle -z.B. A2 der Tabelle Admin- zu verändern? - Danke schon jetzt für die Rückmeldungen. Herzliche Grüße - Wolfgang
Option Explicit
Sub Einfärben()
Dim i As Integer, letzZ As Integer, x As Integer
letzZ = Tabelle2.[I1000].End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To 15
Tabelle1.Shapes.Range(Array("Sitz" & i)).Fill.ForeColor.RGB = RGB(255, 0, 0) _
'Rot
Tabelle1.Shapes.Range(Array("Lamp" & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
Next
For i = 2 To letzZ
x = Tabelle2.Cells(i, 12)
If Tabelle2.Cells(i, 9) = Date Then
Tabelle1.Shapes.Range(Array("Sitz" & x)).Fill.ForeColor.RGB = RGB(64, 130, 63) _
'Grün
Tabelle1.Shapes.Range(Array("Lamp" & x)).Fill.ForeColor.RGB = RGB(64, 130, 63)
End If
If Tabelle2.Cells(i, 9) > Date Then
Tabelle1.Shapes.Range(Array("Lamp" & x)).Fill.ForeColor.RGB = RGB(10, 85, 151) _
'Blau
End If
If Tabelle2.Cells(i, 8) = "storniert" Then _
'Frei geworden
Tabelle1.Shapes.Range(Array("Sitz" & x)).Fill.ForeColor.RGB = RGB(255, 0, 0) _
'Rot
Tabelle1.Shapes.Range(Array("Lamp" & x)).Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
If Tabelle2.Cells(i, 10)