Clever-Excel-Forum

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!

Hallo Erich,

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

Gruß Uwe

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

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!

sharky51

Kuwer

atilla

sharky51