Clever-Excel-Forum

Seiten: 1 2

Hallo zusammen,
ich bin neu hier und hoffe das mein anliegen hier eine Lösung findet, da ich im WWW keine Lösung finden konnte.

Ich erstelle mittels Excel ein Interpretationspapier Gefährdungsbeurteilung. Prinzipiell soll alle Fragen mittels Ja / Nein Befragung zu einen Ergebnis kommen, Wesentliche Änderung oder keine wesentliche Änderung.
Mit Kontrollkästchen die zur Ja/Nein Auswahl dienen, wird einer Aktiven Zelle das Ergebnis Ja oder Nein ausgegeben, dieses Ergebnis soll mit VBA eine Linie die zur nächsten Frage führt färben.
Ja = Grün
Nein = Rot
wenn Kontrollkästchen nicht aktiv ist = Weiß (nicht Sichtbar)

Die Linien färben sich wenn man auf das Kontrollkästchen drückt (WAHR). Wenn man aber ausersehen falsch geklickt hat und das Kontrollkästchen wieder deaktiviert (FALSCH) färben sich die Linien nicht mehr (von Grün auf Weiß).

Wäre super wenn Ihr mir helfen könntet.

Anbei ein Bild vom Interpretationspapier und mein Code dazu.

Code:
Sub Kontrollkästchen50_Klicken()

    ActiveSheet.Shapes.Range(Array("Group 3")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 255, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen52_Klicken()

    ActiveSheet.Shapes.Range(Array("Group 24")).Select

    ActiveSheet.Shapes.Range(Array("Group 24", "Straight Arrow Connector 49")). _

        Select

    ActiveSheet.Shapes.Range(Array("Group 24", "Straight Arrow Connector 49", _

        "Ergebn1")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 255, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen53_Klicken()

    ActiveSheet.Shapes.Range(Array("Group 18")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 255, 0)

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 0, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen54_Klicken()

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 53")).Select

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 53", _

        "Straight Arrow Connector 49")).Select

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 53", _

        "Straight Arrow Connector 49", "Ergebn1")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 255, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen55_Klicken()

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 27")).Select

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 27", _

        "Straight Connector 16")).Select

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 27", _

        "Straight Connector 16", "Raute3")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 0, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen56_Klicken()

    ActiveSheet.Shapes.Range(Array("Group 17")).Select

    ActiveSheet.Shapes.Range(Array("Group 17", "Straight Arrow Connector 27")). _

        Select

    ActiveSheet.Shapes.Range(Array("Group 17", "Straight Arrow Connector 27", _

        "Raute3")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 0, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen57_Klicken()

    ActiveSheet.Shapes.Range(Array("Straight Connector 10")).Select

    ActiveSheet.Shapes.Range(Array("Straight Connector 10", _

        "Straight Arrow Connector 92")).Select

    ActiveSheet.Shapes.Range(Array("Straight Connector 10", _

        "Straight Arrow Connector 92", "Ergebn1")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 255, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen58_Klicken()

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 37")).Select

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 37", "Raute4")). _

        Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 0, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen59_Klicken()

    ActiveSheet.Shapes.Range(Array("Group 14")).Select

    ActiveSheet.Shapes.Range(Array("Group 14", "Straight Arrow Connector 92")). _

        Select

    ActiveSheet.Shapes.Range(Array("Group 14", "Straight Arrow Connector 92", _

        "Ergebn1")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 255, 0)

        .Transparency = 0

    End With

End Sub

Sub Kontrollkästchen60_Klicken()

    ActiveSheet.Shapes.Range(Array("Group 7")).Select

    ActiveSheet.Shapes.Range(Array("Group 7", "Ergebn2")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 0, 0)

        .Transparency = 0

    End With

End Sub

Vielen dank im Voraus.

Und wir sollten das alles neu nachbauen ?

Hi,

(10.05.2016, 13:24)snb schrieb: [ -> ]Und wir sollten das alles neu nachbauen ?

übersetzt heißt das:
Mit einem Bildchen der Datei können wir nicht testen und helfen, also stelle bitte (D)eine (Beispiel-)Tabelle als Excel-Datei zur Verfügung oder stelle die relevanten Ausschnitte hier dar, siehe die als Wichtige Themen: markierten Forums-Beiträge.
Deine Mustertabelle sollte mindestens etwa 10-15 Datensätze haben, sensible Daten anonymisiert. Vom Aufbau her muss sie aber deinem Original gleichen.
Auch ein Wunschergebnis sollte dargestellt und als solches erkennbar sein.
Die farbigen Texte sind anklickbare Links:

Hier steht, wie es geht:
Beitrag 2 WICHTIG: Arbeitsmappen zur Verfügung stellen
Beitrag 3 WICHTIG: Tabellenausschnitte und VBA-Codes im Forum einstellen

Eine Bitte:
Anstatt Screenshots ist eine Datei oder ein Ausschnitt besser!
"Du gehst ja auch nicht in die Werkstatt und gibst ein Foto Deines kaputten Autos ab!"

Hallöchen,

ich denke, die Krux liegt in der nicht vorhandenen Auswertung des Zustandes der Kontrollkästchen. Wenn Du auf die Kästchen drückst, wird immer nur gefärbt und gefärbt und gefärbt ...
Du musst den Zustand auswerten und dementsprechend dann die Farbe setzen.
Im Prinzip
If Kontrollkästchen = TRUE then
grün oder rot
Else
weiß
End If

Das Formular-Kontrollkästchen fragst Du im Prinzip so ab:

Sub Kontrollkästchen1_Klicken()
MsgBox ActiveSheet.Shapes(Application.Caller).DrawingObject.Value
End Sub

[attachment=5256]
Hallo,

ja das wahr vielleicht zu viel Info für den Anfang, danke für den Hinweis.

Vereinfacht gesagt, ich möchte mit Hilfe VBA eine Linie, Peil oder Rechteck in verschiedene Farben Färben.
Sagen wir in A1 Gibt es eine Auswertung JA/Nein, je nach Ergebnis soll das Objekt im Blatt gefärbt werden.

Dank "schauen" habe ich den Code noch mal umgeschrieben, leider ohne erfolgt.

Code:
Sub Test1()

If Range("A1") = "WAHR" Then

ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 2")).Select

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 1, 1)

        .Transparency = 0

    End With

ElseIf Range("A1") = "FALSCH" Then

    ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 2")).Select

    With Selection.ShapeRange.Line

        .Visible = msoFalse

        .ForeColor.RGB = RGB(0, 1000, 1000)

        .Transparency = 0

    End With

End If

End Sub

Code:
Sub M_snb()

   Shapes("snb").Line.ForeColor.RGB = RGB(-(CheckBoxes(1) > 0) * 220, 0, 0)

End Sub

heje excelfreunde, schall87

gehe ich vom namen aus, dann beschäftigt sich schall87 ggf. mit verkehrslärm...wenn ja, dann regelt das "Bundes-Immissionsschutzgesetz" mit den §§ 41 - 43 und in verbindung mit der "16. BImSchV die problematik...wenn nein, dann exaktere hinweise...

Danke snb,

das geht genau in die richtige Richtung.

Nur leider bekomme ich das mit meiner Checkbox nicht hin. In deiner Excel-Datei ändert der Pfeil seine Farbe sofort beim anklicken der Checkbox. Bei mir muss ich erst die Checkbox anklicken und dann in vba code auf run drücken, erst dann ändert der Pfeil die Farbe.

Hast du einen anderen Checkbox verwendet oder wieso funktioniert das bei mir nicht wenn ich dein Code nachbaue?

Hallöchen,

schaue Dir mal an, wie in der Datei von snb das Makro aufgerufen wird bzw. wie die Checkbox mit dem Code zum Färben "verzahnt" ist.

Noch etwas erweitert:

Seiten: 1 2

Schall87

snb

Rabe

schauan

Schall87

snb

radagast

Schall87

schauan

snb