Office: Makro-Problem

Hallo

Mein Problem ist folgendes:

Zum einen möchte ich, dass sich das Register automatisch nach der Zelle $B$6 benennt, wenn in der Zelle $B$4 etwas verändert wird.

Ausserdem soll sich die Farbe des Registers entsprechend dem Inhalt der Zelle $A$11 (1=rot; 2=grün; 0=blau) automatisch verändern, wenn in den Zellen $B$8:$B$9 etwas verändert wird.

Das Makro muss jeweils für das entsprechende register gültig sein, da es möglich sein muss beliebig viele Register mit diesen Bedingungen zu haben.

Habe mal was versucht, wo das mit den Farben aber nicht funktioniert:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("B4:B4")) Is Nothing Then
On Error GoTo fehlermeldung
If Target = "" Then Exit Sub
ActiveSheet.Name = Range("B6").Value
End If

If Not Application.Intersect(Target, Range("B8:B9")) Is Nothing Then
If Range("A11") = "1" Then ActiveWorksheet.Tab.ColorIndex = 3
ElseIf Range("A11") = "2" Then ActiveWorksheet.Tab.ColorIndex = 4
ElseIf Range("A11") = "0" Then ActiveWorksheet.Tab.ColorIndex = 37

End If

Exit Sub

fehlermeldung:
MsgBox "Grober Fehler: Komplex schon vorhanden! Registername wurde nicht verändert!"
End Sub

Könnt ihr mir helfen?

Danke!!

 

ich hätte die Aufgabe so interpretiert unter DieseArbeitsmappe

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Address = "$B$4" Then ActiveSheet.Name = Range("B6")
    If Not Application.Intersect(Target, Range("B8:B9")) Is Nothing Then
        Select Case Target.Value
            Case 1
                ActiveSheet.Tab.ColorIndex = 3
            Case 2
                ActiveSheet.Tab.ColorIndex = 4
            Case 0
                ActiveSheet.Tab.ColorIndex = 37
            Case Else
                ActiveSheet.Tab.ColorIndex = xlNone
        End Select
    End If
End Sub

 

Fehler

Hallo

Leider funktioniert die automatische Namensänderung des Registers nicht.

Auch die Farbänderung funktioniert nicht.

Bei der Farbänderung ist noch folgendes wichtig: Sobald in den Feldern $B$8 oder $B$9 etwas verändert wird, soll der Wert aus der Zelle $A$11 die Farbe bestimmen.


Danke für die Hilfe.

 

bei mir geht es ersetze die Zahl durch Range("A1"), das Stand nicht im ersten Beitrag.

 

Missverständnis

Vielleich haben wir uns falsch verstanden.

Wenn ich in den Zellen $B$8 oder $B$9 etwas ändere, schaut Excel, was in der Zelle $A$11 steht. Wenn dort eine "1" steht, wird das Register rot, wenn eine "2" steht grün, sonst blau.

Danke und Gruss

 

dann schreibe nicht "A1" sondern "A11". Die zahl nach = war gemeint

 

Wäre das so richtig? In den Zellen $B$8 und $B$9 kann man nur Ja oder Nein auswählen. In der Zelle $A$11 steht dann der Wert, welche Farbe genommen werden soll.

Schön wäre noch, wenn ein Register nach einem schon vorhandenen benannt werden soll, eine Fehlermeldung erscheintl.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$B$4" Then ActiveSheet.Name = Range("B6")
If Not Application.Intersect(Target, Range("B8:B9")) Is Nothing Then
Select Case Target.Value
Case 1
ActiveSheet.Tab.ColorIndex = Range("A11")
Case 2
ActiveSheet.Tab.ColorIndex = Range("A11")
Case 3
ActiveSheet.Tab.ColorIndex = Range("A11")
Case Else
ActiveSheet.Tab.ColorIndex = xlNone
End Select
End If
End Sub

 

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Address = "$B$4" Then
        Dim WsTabelle As Worksheet
        For Each WsTabelle In Worksheets
            If WsTabelle.Name = Range("B4") Then
                Beep
                MsgBox "Die Tabelle ist schon vorhaden!"
                Exit Sub
            End If
        Next WsTabelle
        ActiveSheet.Name = Range("B6")
    ElseIf Not Application.Intersect(Target, Range("B8:B9")) Is Nothing Then
        Select Case Target.Value
            Case 1
                ActiveSheet.Tab.ColorIndex = Range("A11")
            Case 2
                ActiveSheet.Tab.ColorIndex = Range("A11")
            Case 0
                ActiveSheet.Tab.ColorIndex = Range("A11")
            Case Else
                ActiveSheet.Tab.ColorIndex = xlNone
        End Select
    End If
End Sub

 

Farbe

Muss nochmal stören

In den Zellen $B$8 und $B$9 kann ich "Ja" oder "Nein" auswählen (Gültigkeit/Liste). Daraus ergibt sich in der Zelle $A$11 via wenn-dann-Formel ein Faktor (1; 2 oder 0).

Bei dem Faktor 1 soll das Register rot, bei 2 grün und bei 0 blau angezeigt werden.

Auslöser für die Ausführung soll eine Änderung in den Zellen $B$8 oder $B$9 sein.

Das funktioniert bisher noch nicht.

ElseIf Not Application.Intersect(Target, Range("B8:B9")) Is Nothing Then
Select Case Target.Value
Case 1
ActiveSheet.Tab.ColorIndex = Range("A11")
Case 2
ActiveSheet.Tab.ColorIndex = Range("A11")
Case 0
ActiveSheet.Tab.ColorIndex = Range("A11")
Case Else
ActiveSheet.Tab.ColorIndex = xlNone