Excel vba Workbook_SheetChange - Problem

[sharky51]

Hallo zusammen,

ich würde mich freuen wenn Ihr mir bei einem Problem weiterhelfen könntet.

Von Hajo habe ich ein tolles Macro gefunden das bei Änderungen, egal in welchen Tabellenblättern seinen Dienst tut.
Also wenn ich in einer Zelle einen bestimmten Eintrag einfüge dann reagiert das Makro das in "DieserArbeitsmappe" eingefügt ist.
Soweit so gut.

Da ich aber immer wieder neue Tabellenblätter einfügen muss und diese dann gleich automatisch mit Informationen fülle schlägt das Macro unweigerlich zu und bringt dann diese Fehlermeldung:
"Laufzeitfehler 1004: Die Methode Intersect für das Objekt_Global ist fehlgeschlagen.
Gibt es hier eine Möglichkeit das Workbook_SheetChange irgendwie zu blockieren wenn neue Blätter eingefügt werden und diese dann mit Default-Informationen gefüllt werden?
Oder gibt es eine andere Möglichkeit?

Hier das Macro von Hajo:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  '***********************************************
  '* H. Ziplies                                  *
  '* 21.06.15                                    *
  '* erstellt von HajoZiplies@web.de            *
  '* http://Hajo-Excel.de/                      *
  '***********************************************
  ' Füllfarbe
  ' für Schrift RaZelle.Font.ColorIndex
  Dim RaBereich As Range                          ' Variable für Bereich
  Dim RaZelle As Range                            ' Variable für Zelle
  Set RaBereich = Range("B2:BF51")                ' Bereich der Wirksamkeit

    Set RaBereich = Intersect(RaBereich, Target)
  If Not RaBereich Is Nothing Then
      'ActiveSheet.Unprotect ("Passwort")
      For Each RaZelle In RaBereich
        With RaZelle
            Select Case UCase(.Value)          ' Umwandlung der Eingabe in Großbuchstaben
              Case "1"
                  .Interior.Color = 0        ' Füllfarbe Schwarz
                  .Font.Color = 16777215      ' Schriffarbbe weiß
                  .NumberFormat = "General"  ' Zellenformat Standard
              Case "2"
                  .Interior.Color = 65535    ' Füllfarbe Gelb
                  ' Schriffarbe automatisch
                  .Font.ColorIndex = xlAutomatic
                  .NumberFormat = "General"
              Case "3"
                  .Interior.Color = 255      ' Füllfarbe Rot
                  .NumberFormat = "General"  ' Zellenformat Standard
                  '.NumberFormat = ";;;"      ' Zellformat nicht sichtbar
              Case "4"
                  .Interior.Color = 65280    ' Füllfarbe Grün
                  .Font.ColorIndex = xlAutomatic
                  .NumberFormat = "General"
              Case "FOCUS"
                  .Interior.Color = 16711680  ' Füllfarbe blau
                  .Font.Color = 12632256      ' Schriftfarbe Grau - 25%
                  .NumberFormat = "General"
              Case Else
                  ' keine Füllfarbe, ColorIndex nicht Color
                  .Interior.ColorIndex = 50  ' oder xlNone
                  .Font.ColorIndex = xlAutomatic
                  .NumberFormat = "General"
            End Select
        End With
      Next RaZelle
      'ActiveSheet.protect ("Passwort")
  End If
  Set RaBereich = Nothing                        ' Variable leeren
 
End Sub

Vielen Dank für Eure Hilfe!

[Kuwer]

Hallo Erich,

aktiviere vor dem Einfügen neuer Blätter den Entwurfsmodus. Wenn Du fertig bist, deaktivierst Du ihn wieder.

Gruß Uwe

[atilla]

Hallo Erich,

ich konnte den Fehler bei mir nicht reproduzieren.
Du kannst aber für alle Fälle mit On Error Goto arbeiten.

z.B. so:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  '***********************************************
  '* H. Ziplies                                  *
  '* 21.06.15                                    *
  '* erstellt von HajoZiplies@web.de            *
  '* http://Hajo-Excel.de/                      *
  '***********************************************
  ' Füllfarbe
  ' für Schrift RaZelle.Font.ColorIndex
  Dim RaBereich As Range                          ' Variable für Bereich
  Dim RaZelle As Range                            ' Variable für Zelle
  Set RaBereich = Range("B2:BF51")                ' Bereich der Wirksamkeit
On Error GoTo fehler
    Set RaBereich = Intersect(RaBereich, Target)
  If Not RaBereich Is Nothing Then
      'ActiveSheet.Unprotect ("Passwort")
      For Each RaZelle In RaBereich
        With RaZelle
            Select Case UCase(.Value)          ' Umwandlung der Eingabe in Großbuchstaben
              Case "1"
                  .Interior.Color = 0        ' Füllfarbe Schwarz
                  .Font.Color = 16777215      ' Schriffarbbe weiß
                  .NumberFormat = "General"  ' Zellenformat Standard
              Case "2"
                  .Interior.Color = 65535    ' Füllfarbe Gelb
                  ' Schriffarbe automatisch
                  .Font.ColorIndex = xlAutomatic
                  .NumberFormat = "General"
              Case "3"
                  .Interior.Color = 255      ' Füllfarbe Rot
                  .NumberFormat = "General"  ' Zellenformat Standard
                  '.NumberFormat = ";;;"      ' Zellformat nicht sichtbar
              Case "4"
                  .Interior.Color = 65280    ' Füllfarbe Grün
                  .Font.ColorIndex = xlAutomatic
                  .NumberFormat = "General"
              Case "FOCUS"
                  .Interior.Color = 16711680  ' Füllfarbe blau
                  .Font.Color = 12632256      ' Schriftfarbe Grau - 25%
                  .NumberFormat = "General"
              Case Else
                  ' keine Füllfarbe, ColorIndex nicht Color
                  .Interior.ColorIndex = 50  ' oder xlNone
                  .Font.ColorIndex = xlAutomatic
                  .NumberFormat = "General"
            End Select
        End With
      Next RaZelle
      'ActiveSheet.protect ("Passwort")
  End If
 
fehler:
  Set RaBereich = Nothing                        ' Variable leeren

End Sub

[sharky51]

Hallo Uwe,

kannst Du das näher erklären? Kann man das ins das Makro integrieren?
Im www habe ich folgendes gefunden:

Am Anfang des beschriebenen Codes habe ich
Application.CommandBars("control Toolbox").Controls(1).Execute
und am Ende
Application.CommandBars("control Toolbox").Controls(1).Reset
einfügt.

Das funktioniert aber nicht...oder ich habe es falsch verstanden.

---

Hallo atilla,

dein Vorschlag hat die Fehlermeldung unterdrückt .... und der Code läuft dann sauber durch.

Danke für die Hilfe!