Farbige Zellen zurücksetzen
20.04.2022 18:35:15
mike49
ich habe ein Löschen Makro, dass die Inhalte des Tabellblattes bzw. alle Tabellenblätter löscht. Das funktioniert auch.
Jetzt hätte ich das gerne erweitert, dass auch die manuell eingefärbten Zellen zurückgesetzt werden (farblos machen).
Meine Erweiterungszeile (.Range("D3:L33").Interior.ColorIndex = 0) funktioniert nicht! Was habe ich falsch gemacht?
Option Explicit
Sub Löschen()
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("D3:L33").ClearContents
.Range("D3:L33").Interior.ColorIndex = 0
' .Range("H5:H35").FormulaLocal = _
' "=WENN(ISTNV(INDEX($R$9:$S$37;VERGLEICH($B5;$R$9:$R$37;0);2));"""";INDEX($R$9:$S$37;VERGLEICH($B5;$R$9:$R$37;0);2))"
' .Range("D37").Value = "0"
.Range("E1").Select
' .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 = 3
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("D3:L33").ClearContents
.Range("D3:L33").Interior.ColorIndex = 0
' .Range("H5:H35").FormulaLocal = _
' "=WENN(ISTNV(INDEX($R$9:$S$37;VERGLEICH($B5;$R$9:$R$37;0);2));"""";INDEX($R$9:$S$37;VERGLEICH($B5;$R$9:$R$37;0);2))"
' .Range("D37").Value = "0"
' .Protect
Application.GoTo .Range("E1")
ActiveWindow.ScrollRow = 3
ThisWorkbook.Sheets("Jan").Activate
End With
TABELLE_AUF_NULL = True 'Erfolg vermerken.
Ende:
' On Error GoTo 0 'Fehlerbehandlung zurückgeben.
End Function
mike49