Office: (Office 2013) VBA Autoform einfärben

Hallo zusammen,

ich brauche dringend eure Hilfe. Habe schon überall nach einer Lösung gesucht, aber komme nicht zum richtigen Ergebnis.

Ich habe zwei verschiedene Arbeitsblätter in meiner Exceldatei erstellt.
Auf dem einen Blatt "Tabelle4" sind alle Werte zusammengeführt.
Auf dem anderen Blatt "Tabelle8" sind meine Autoformen wiederzufinden.

Meine Autoform "rechteck1" soll die Farbe unter drei verschiedenen Bedingungen ändern.

- Wenn der Wert (Zelle C11) auf Blatt "Tabelle4" < 31 ist, soll die Form auf Blatt "Tabelle8" rot werden.
- Wenn der Wert (Zelle C11) auf Blatt "Tabelle4" > 30 und < 80 ist, soll die Form auf Blatt "Tabelle8" orange werden.
- Wenn der Wert (Zelle C11) auf Blatt "Tabelle4" >79 ist, soll die Form auf Blatt "Tabelle8" grün werden.

Ich habe bisher folgenden Code verwendet:

Private Sub Worksheet_Change(ByVal Target As Range)
Sub FarbeRechteck()

If Tabelle4.Range("C11") > 79 Then
With Tabelle8.Shapes("Rechteck1").Fill
.ForeColor.RGB = RGB(0, 179, 0)
End With
End If
If Tabelle4.Range("C11") < 31 Then
With Tabelle8.Shapes("Rechteck1").Fill
.ForeColor.RGB = RGB(238, 0, 0)
End With
End If
If Tabelle4.Range("C11") > 30 And Tabelle4.Range("C11") < 80 Then
With Tabelle8.Shapes("Rechteck1").Fill
.ForeColor.RGB = RGB(255, 140, 0)
End With
End If
End Sub

Der Code funktioniert aber die Farben ändern sich nicht automatisch, sondern ich muss erst immer wieder den Code anzeigen und ausführen lassen. Ich möchte aber, dass sich die Autoform automatisch ändert, sobald sich der Wert verändert.

Ich muss dazu sagen, dass ich ein echter Anfänger in Sachen VBA bin..


Ich hoffe, ihr könnt mir helfen :)

Betse Grüße
stseca

 

Hi,

meinst du das vielleicht so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells(1).Address(False, False) = "C11" Then
        If Target.Cells(1).Value > 79 Then
            Tabelle8.Shapes("Rechteck1").Fill.ForeColor.RGB = RGB(0, 179, 0)
        ElseIf Target.Cells(1).Value > 30 And Target.Cells(1).Value < 80 Then
            Tabelle8.Shapes("Rechteck1").Fill.ForeColor.RGB = RGB(238, 0, 0)
        ElseIf Target.Cells(1).Value < 31 Then
            Tabelle8.Shapes("Rechteck1").Fill.ForeColor.RGB = RGB(255, 140, 0)
        End If
    End If
End Sub

Der Code befindet sich im Codemodul von Tabelle4

Bis später,
Karin

 

Hey Karin,
vielen Dank für deine schnelle Antwort. Es hat geklappt:) Jetzt habe ich allerdings einmal alle alten Codes rausgelöscht und in Tabelle 4 den neuen Code geschrieben.
Jetzt erscheint die Fehlermeldung "Objekt erforderlich". Was bedeutet dies?

Beste Grüße
stseca

 

Hi,

an weclher Stelle im Code erschjeint die Fehlermeldung? Gibt es vielleicht Tabelle8 nicht oder heißt das Rechteck nicht "Rechteck1"?
Falls keins davon zutrifft solltest du mal deine Mappe hochladen.

Bis später,
Karin

 

Es hat geklappt :) Habe noch einmal alles gelöscht und neu eingefügt. Juhu vielen lieben Dank !! :-)

Jetzt besteht nur noch ein Problem: Wenn ich den Wert in der Zelle "C11" manuell ändere, dann verändert sich die Farbe der Autoform wie gewünscht automatisch.
Der Wert in der Zelle "C11" entsteht aber durch eine Formel.
Und so funktioniert die automatische Farbänderung der Autoform leider nicht. Irgendwie wird der Wert nicht erkannt...Was muss ich tun ?:/

Grüße
stseca

 

Darauf hättest du gleich in deinem Eröffnungsbeitrag hinweisen sollen...

Auf welche Zellen bezieht sich deine Formel? Diese Zellen musst du dann überwachen anstelle von C11.

Bis später,
Karin

 

Hey,

das tut mir leid. Ich habe eine lange Tabelle auf einem anderen Arbeitsblatt "Tabelle3". Die dort aufgeführten Punkte werden nach einer Bedingung überprüft. Wenn die Bedingung zutrifft, kommt in die Spalte daneben ein "x".
Auf dem Arbeitsblatt "Tabelle4" werden diese "x" gezählt und in Abhänngigkeit von der Gesamtanzahl an Zeilen berechnet und dann in der Zeile C11 wiedergegeben.
Ich will quasi angeben, dass wenn mind. 80% mit einem x versehen sind, dann soll die Autoform grün sein, wenn unter 30% dann rot, usw.

Grüße
stseca

 

Datei

Ich habe eine Beispieldatei mit meinem Problem einmal beigefügt :)

 

Folgenden Code ins Codemodul der Tabelle3:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(2)) Is Nothing Then
        If Worksheets("Tabelle4").Range("C11").Value > 79 Then
            Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(0, 179, 0)
        ElseIf Target.Cells(1).Value > 30 And Target.Cells(1).Value < 80 Then
            Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(238, 0, 0)
        ElseIf Target.Cells(1).Value < 31 Then
            Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(255, 140, 0)
        End If
    End If
End Sub

Es wird also Spalte B der "Tabelle3" überwacht, da du dort die "x" einträgst oder löschst.


Wenn du ein Tabellenblatt mit dem Namen ansprechen willst der unten auf dem Reiter steht (bzw. im VBA-Editor in Klammern), dann musst du Worksheets("TabellenName") verwenden. Deine Verwendung von Tabelle8.Shapes(....) spricht das Tabellenblatt mit seinem internen oder Code-Namen an - das ist der Name der im VBA-Editor vor dem Namen in Klammern steht. Beides ist möglich, aber mann muss es richtig einsetzen.
Außerdem musst du darauf achten, wie die genaue Bezeichnung der eingefügten Form ist: in deinem Beispiel ist es "Rechteck 1" und nicht "Rechteck1" - achte auf das Leerzeichen vor der 1.

Bis später,
Karin

 

Hallo,

ich habe noch einmal eine zweite Datei reingestellt.

Mein Problem ist nämlich, dass diese Datei nur ein Ausschnitt war. Die Tabelle ist noch deutlich größer. Die neue Datei veranschaulicht das Problem, dass der Code sich auf unterschiedliche Abschnitte beziehen soll. Sprich in der Spalte sind noch deutlich mehr Fakten.
Das Ziel ist, dass ich mehrere Codes erstelle und jeder sich auf einen Abschnitt der Spalte bezieht.


Grüße
stseca

 

Das ist die neue Datei. Sorry

 

Hi,

das ist doch dieselbe Datei nur als xlsx-Version. und es gibt nur einen Bereich in den etwas eignetragen wird und nicht mehrere.

Außerdem sollte man schon eine xlsm-Datei mit dem entsprechenden bereits vorhandenen Code hochladen, wenn man ein VBA-Problem erörtert.

Bis später,
Karin

 

Hallo,

du hast Recht. Das war nicht verständlich.

Jetzt noch einmal eine vernünftige Datei, aus dessen Code hoffentlich mein Problem hervorgeht.
Ich will einen Code erstellen, der einmal für Affe-Löwe die Bedingung prüft, dann für A-D die Bedingung prüft und für 1-5 die Bedingung prüft.


Liebe Grüße
stseca

 

So sollte der Code richtig sein:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(2)) Is Nothing Then
        If Worksheets("Tabelle4").Range("C11").Value > 79 Then
            Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(0, 179, 0)
        ElseIf Worksheets("Tabelle4").Range("C11").Value > 30 And Worksheets("Tabelle4").Range("C11").Value < 80 Then
            Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(238, 0, 0)
        ElseIf Worksheets("Tabelle4").Range("C11").Value < 31 Then
            Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(255, 140, 0)
        End If
        If Worksheets("Tabelle4").Range("D11").Value > 79 Then
            Worksheets("Tabelle8").Shapes("Rechteck 2").Fill.ForeColor.RGB = RGB(0, 179, 0)
        ElseIf Worksheets("Tabelle4").Range("D11").Value > 30 And Worksheets("Tabelle4").Range("D11").Value < 80 Then
            Worksheets("Tabelle8").Shapes("Rechteck 2").Fill.ForeColor.RGB = RGB(238, 0, 0)
        ElseIf Worksheets("Tabelle4").Range("D11").Value < 31 Then
            Worksheets("Tabelle8").Shapes("Rechteck 2").Fill.ForeColor.RGB = RGB(255, 140, 0)
        End If
        If Worksheets("Tabelle4").Range("E11").Value > 79 Then
            Worksheets("Tabelle8").Shapes("Rechteck 3").Fill.ForeColor.RGB = RGB(0, 179, 0)
        ElseIf Worksheets("Tabelle4").Range("E11").Value > 30 And Worksheets("Tabelle4").Range("E11").Value < 80 Then
            Worksheets("Tabelle8").Shapes("Rechteck 3").Fill.ForeColor.RGB = RGB(238, 0, 0)
        ElseIf Worksheets("Tabelle4").Range("E11").Value < 31 Then
            Worksheets("Tabelle8").Shapes("Rechteck 3").Fill.ForeColor.RGB = RGB(255, 140, 0)
        End If
    End If
End Sub

Bis später,
Karin

 

Es hat geklappt! Danke! Tausend Dank Karin:))

Grüße
stseca