Office: (Office 2013) VBA Autoform einfärben

Hey,

eine andere Frage habe ich auch noch. Kann man den Code zu schreiben, dass bestimmte Shapes weiß bleiben. Immer der jeweils erste soll eig weiß bleiben und die Werte beziehen sich erst auf die jeweils darauffolgenden Shapes.
Sprich: Der Shape, der bei dir "C11_" heißt, soll weiß bleiben (kein Bezug zu den Daten) und der Shape "D11_" ist dann bei mir erst "C11_".
Dadrunter dann genau das gleiche immer.

Viele Grüße
stseca

 

Hi,

was meinst du mit "der Reihe nach ändere"? Man kann zuerst in Spalte 13 ein x eintragen, dann wird zuerst im Tabellenblatt mit der Überschrift aus Spalte 13 etwas geändert und wenn anschließend in Spalte 11 ein x eingetragen wird, ändern sich die Farben im Tabellenblatt mit der Überschrift aus Spalte 11 usw. Dasselbe trifft auch zu, wenn zuerst in Zeile 48 ein x und dann in Zeile 28 ein X eignetragen wird. Der Code ist völlig unabhängig von der Reihenfolge.

Die Spaltennummer darf natürlich nicht mehrfach vorkomen - schau einfach in welcher Spalte sich deine Überschriften zu welchem Tabellenblatt befindet.

 

Hey,
wenn ich zum Beispiel in Zeile K10 ein x setze, dann wird das entsprechende shape grün. Wenn ich dann in Zeile K12 bis K15 ein x setze passiert mit dem zugehörigen Shape nichts (müsste gelb werden). Erst wenn ich in Zeile K21 wieder ein x setze, färben sich das zugehörige und das vorherige Shape.
Kannst du nachvollziehen was ich meine?

Grüße
stseca

 

Hi,

wenn ich in K10 ein x setze erhalte ich folgende Farbabfolge: Grün -> Rot -> Gelb -> Grün (100% -> 0% -> 33,33% -> 100% in den Zellen C10, D10, F10, G10)
danach in K12 ein x ergibt folgende Farbabfolge: Grün -> Rot -> Gelb -> Grün (100% -> 16,67% -> 33,33% -> 100% in den Zellen C10, D10, F10, G10)
danach in K13 ein x ergibt folgende Farbabfolge: Grün -> Gelb -> Gelb -> Grün (100% -> 33,33% ->33,33% -> 100% in den Zellen C10, D10, F10, G10)
danach in K14 ein x ergibt folgened Farbabfolge: Grün -> Gelb -> Gelb -> Grün (100% -> 50% ->33,33% -> 100% in den Zellen C10, D10, F10, G10)
danach in K15 ein x ergibt folgende Farbabfolge: Grün -> Gelb -> Gelb -> Grün (100% -> 66,67% ->33,33% -> 100% in den Zellen C10, D10, F10, G10)

Das entspricht genau den vorgegebenen %-Angaben.


Aber mal davon abgesehen solltest du nicht nur die Eingabe von X prüfen sondern auch das Löschen einer Eingabe - davon war zwar bisher nicht die Rede, ist m.E. aber richtiger so, weil dann beim Löschen von Eingaben der Code ebenfalls ausgeführt und Farben zurückgesetzt werden:

Code:

    If blnAusfuehren Then
        With Worksheets(strTabelle)
            For Each shaShape In .Shapes
                If shaShape.AutoShapeType = 51 Or shaShape.AutoShapeType = 52 Then
                    strZelle = Application.Substitute(shaShape.Name, "_", "")
                    If .Range(strZelle).Value > 79 Then
                        shaShape.Fill.ForeColor.RGB = RGB(0, 179, 0)
                    ElseIf .Range(strZelle).Value > 30 And Range(strZelle).Value < 80 Then
                        shaShape.Fill.ForeColor.RGB = RGB(255, 255, 0)
                    ElseIf .Range(strZelle).Value < 31 Then
                        shaShape.Fill.ForeColor.RGB = RGB(238, 0, 0)
                    End If
                End If
            Next shaShape
        End With
    End If

Bis später,
Karin

 

Hey,

ich bin mir nicht ganz sicher, aber vielleicht war genau das das Problem. Wie muss ich diesen neuen Code in meinen alten einfügen, damit dies funktioniert? Habe ihn so eingesetzt, aber das klappt dann noch nicht.

Code:

        If UCase(Target.Cells(1)) = "X" Then
            strTabelle = "Prozessverantwortung"
            blnAusfuehren = True
        End If
    ElseIf Not Intersect(Target, Columns(12)) Is Nothing Then
        If UCase(Target.Cells(1)) = "X" Then
            strTabelle = "ChancenRisiken"
            blnAusfuehren = True
        End If
    End If
    If blnAusfuehren Then
        With Worksheets(strTabelle)
            For Each shaShape In .Shapes
                If shaShape.AutoShapeType = 51 Or shaShape.AutoShapeType = 52 Then
                    strZelle = Application.Substitute(shaShape.Name, "_", "")
                    If .Range(strZelle).Value > 79 Then
                        shaShape.Fill.ForeColor.RGB = RGB(0, 179, 0)
                    ElseIf .Range(strZelle).Value > 30 And Range(strZelle).Value < 80 Then
                        shaShape.Fill.ForeColor.RGB = RGB(255, 255, 0)
                    ElseIf .Range(strZelle).Value < 31 Then
                        shaShape.Fill.ForeColor.RGB = RGB(238, 0, 0)
                    End If
                End If
            Next shaShape
        End With
    End If
      If blnAusfuehren Then
        With Worksheets(strTabelle)
            For Each shaShape In .Shapes
                If shaShape.AutoShapeType = 51 Or shaShape.AutoShapeType = 52 Then
                    strZelle = Application.Substitute(shaShape.Name, "_", "")
                    If .Range(strZelle).Value > 79 Then
                        shaShape.Fill.ForeColor.RGB = RGB(0, 179, 0)
                    ElseIf .Range(strZelle).Value > 30 And Range(strZelle).Value < 80 Then
                        shaShape.Fill.ForeColor.RGB = RGB(255, 255, 0)
                    ElseIf .Range(strZelle).Value < 31 Then
                        shaShape.Fill.ForeColor.RGB = RGB(238, 0, 0)
                    End If
                End If
            Next shaShape
        End With
    End If
End Sub

Grüße
stseca

 

Hi,

oh sorry, da habe ich den falschen Code gepostet - also dieser ist der richtige

Code:

        If UCase(Target.Cells(1)) = "X" [COLOR=#ff0000][B]Or Target.Cells(1) = ""[/B][/COLOR] Then
            strTabelle = "DEBI"
            blnAusfuehren = True
        End If

Du musst an allen Stellen den rot formatierten Text ergänzen (einfach die Zeile markieren und im alten Code komplett ersetzen - ist ja bei jedem Tabellenblatt derselbe)

Bis später,
Karin

 

Hallo Karin,

es funktioniert :)
Eine allerletzte Frage: Ich würde eigentlich gerne das Shape E11_ weiß lassen. Hier soll sich die Farbe nicht ändern. Gibt es einen möglichen Zusatz für den Code, dass dieses Shape nicht betrachtet wird, bzw. weiß gelassen wird?

Viele Grüße
stseca

 

Hi,

ergänze den Code wir folgt:

Code:

                If shaShape.AutoShapeType = 51 Or shaShape.AutoShapeType = 52 Then
                    strZelle = Application.Substitute(shaShape.Name, "_", "")
                    [COLOR=#ff0000]If strZelle <> "E11_" Then[/COLOR]
                        If .Range(strZelle).Value > 79 Then
                            shaShape.Fill.ForeColor.RGB = RGB(0, 179, 0)
                        ElseIf .Range(strZelle).Value > 30 And Range(strZelle).Value < 80 Then
                            shaShape.Fill.ForeColor.RGB = RGB(255, 255, 0)
                        ElseIf .Range(strZelle).Value < 31 Then
                            shaShape.Fill.ForeColor.RGB = RGB(238, 0, 0)
                        End If
                    [COLOR=#ff0000]End If[/COLOR]
                End If

Bis später,
Karin

 

Hallo Karin,

komischerweise verfärbt es sich immer noch immer wieder rot.

Lieben Gruß
stseca

 

Hi,

entferne den "_" bei "E11_" in der rot markierten Zeile, der wird bereits in der vorergehennden Codezeile entfernt.

Bis später,
Karin

 

Hey Karin,

ich weiß garnicht wie ich dir danken soll. Jetzt ist alles perfekt. Vielen vielen Dank für deine Hilfe!

Ganz lieben Gruß
stseca :-)

 

Hi,

deine Rückmeldung und dass das Programm jetzt das macht was du dir vorgestellt hast, sind mir Dank genug. :)

Bis später,
Karin