Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1332to1336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ampelfunktion

Ampelfunktion
18.10.2013 16:45:44
Stefan
Hallo Zusammen,
habe ein kleines Problem.
Hatte in der XLS97er Version folgendes Makro:
' 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, 57).Value
Case "ok"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 11 ' grün
Case "in Arbeit"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 13 ' gelb
Case "Termin"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 10 ' rot
Case "abgeschlossen"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 8 ' schwarz
Case "Muster"
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
Welches mir Kreise je nach Zellinhalt eingefärbt hat.
Das Makro läuft leider unter XLS2010 nicht mehr.
Es gibt in XLS ja die Ampelfunktion. Bei der hab ich allerdings das Problem,
dass meine Ampel in Spalte A, B oder C liegt. Der dazugehörige Wert jedoch erst
in Spalte BE (57) ist.
Wer kann mir sagen, wie ich das Macro anpassen muß, so dass dies auch unter XLS10 läuft ?
Oder wer weiß wie man eine Ampelsteuereung (Anzeige z.B. in Spalte A) den Wert dazu jedoch erst in Spalte BE hat ?
Liebe Grüße
Stefan

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Code funktioniert mit kleiner Änderung
18.10.2013 17:42:56
NoNet
Hallo Stefan,
der Code funktioniert mit einer kleinen Änderung einwandfrei - teste mal diesen Code :
Sub Ovale_Einfaerben()
For InI = 1 To ActiveSheet.Shapes.Count
' Namen des Steuerelementes prüfen
If Mid(ActiveSheet.Shapes(InI).Name, 1, 4) = "Oval" Then
' Zeile die abgefragt werden soll
Select Case Cells(ActiveSheet.Shapes(InI).BottomRightCell.Row, 57).Value
Case "ok"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 11 ' grün
Case "in Arbeit"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 13 ' gelb
Case "Termin"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 10 ' rot
Case "abgeschlossen"
ActiveSheet.Shapes(InI).Fill.ForeColor.SchemeColor = 8 ' schwarz
Case "Muster"
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

Gruß, NoNet
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige