Makro funktioniert nicht richtig
26.10.2022 20:11:40
mike49
ich habe ein Löschen-Makro, das in den Blättern Jan-Dez den Bereich E6:H36 und die Zelle R6 löschen soll.
Beim Drücken des Löschen-Buttons in einem Monatsblatt gehen auch die msg-Boxen auf und am Ende kommt auch die Meldung, dass alle Blätter auf Null gesetzt wurden, wenn dies gewünscht wird.
Dem ist aber nicht so. Es werden nur die Werte im aktiven Blatt zurückgesetzt. Die Werte in den anderen Blättern aber nicht!
Was habe ich falsch gemacht?
Sub Löschen()
'Sub Löschen(Optional Dummy As Byte)
Dim strAntwort As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
.Calculation = xlCalculationManual
End With
With ActiveSheet
' .Unprotect
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
' .Protect
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
If ANDERE_TABELLEN = True Then
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.ScreenUpdating = True 'Bildschirmaktualisierung abschalten.
.EnableEvents = True 'Ereignissprozeduren deaktivieren.
.Calculation = xlCalculationAutomatic
' .ActiveWindow.ScrollRow = 9
End With
End Sub
Private Function ANDERE_TABELLEN() As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name ActiveSheet.Name And Len(Sh.Name) = 3 Then
If TABELLE_AUF_NULL(Sh.Name) = False Then
MsgBox "Fehler bei Tabelle: " & Sh.Name, _
vbCritical, "Abbruch"
Exit Function
End If
End If
Next
ANDERE_TABELLEN = True 'Erfolg vermerken.
End Function
Private Function TABELLE_AUF_NULL(strTabelle As String) As Boolean
' On Error GoTo Ende 'Fehlerbehandlung übernehmen.
With ThisWorkbook.Sheets(strTabelle) 'Alles auf dieses Tabellenblatt beziehen:
.Unprotect
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
' .Range("F42").Value = "0"
' ActiveWindow.ScrollRow = 9
' ThisWorkbook.Sheets("Jan").Range("R6").Value = "0"
' ThisWorkbook.Sheets("Jan").Activate
End With
TABELLE_AUF_NULL = True 'Erfolg vermerken.
Ende:
' On Error GoTo 0 'Fehlerbehandlung zurückgeben.
End Function
Grußmike49