Farbe einer Autoform ändert sich je nach Tabellenw
02.10.2012 13:57:48
Schick
bin neu hier und ehrlich gesagt aktuell etwas verzweifelt. Komme mit meinem Makro nicht weiter.
Ausgangssituation:
- abhängig ob eine Zelle einen Inhalt hat (mittels Auswahlfeld), wird eine 0 oder 1 ausgegeben.
- Jede Zelle mit 1 wird summiert und in einer Zielzelle ausgegeben
- Ist der Zellwert der Zielzelle >=2, dann soll die Autoform farbig markiert werden
Nun meine Probleme:
- Autoform war vorher grau, dann bei erfüllter Bedinung grün. Wird der Zellinhalt auf Null gesetzt, dann kommt folgende Fehlermeldung "Laufzeitfehler 13 Typen unverträglich. Geht man auf Beenden, läuft das Marko nicht mehr weiter.
- Außerdem wird die vorher grau formatierte Autoform jetzt schwarz und nicht mehr grau
- Ab jetzt funktioniert die Abhängigkeit von der Zielzelle nicht mehr. Erst wenn man die Summenformel durch den Wert 2 oder größer überschreibt, wird die Zelle wieder grün, das hilft mir aber nicht wirklich weiter. Soll heißen, dass die Abhängigkeit von der Summe nicht richtig funktioniert.
Anbei noch mein Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("M29") Then
ActiveSheet.Shapes("Marke").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
If Target = Range("M66") Then
ActiveSheet.Shapes("Kunde").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
If Target = Range("M100") Then
ActiveSheet.Shapes("Talente").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
If Target = Range("M134") Then
ActiveSheet.Shapes("Innovation").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
If Target = Range("M169") Then
ActiveSheet.Shapes("Wachstum").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
End Sub
Private Function fctFarbe(dblWert As Double) As Byte
Select Case dblWert
Case Is >= 2
fctFarbe = 50
End Select
End Function
Link zum Dokument:
https://www.herber.de/bbs/user/81957.xlsm
Vielen Dank für Euro Rückmeldung
MFG