Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Excel vba Workbook_SheetChange - Problem
#1
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!
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#2
Hallo Erich,

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

Gruß Uwe
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • sharky51
Antwortento top
#3
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
Gruß Atilla
[-] Folgende(r) 1 Benutzer sagt Danke an atilla für diesen Beitrag:
  • sharky51
Antwortento top
#4
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!
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste