Macro alleen uitvoeren als blad bestaat

[oceanrace]

Hallo,

Onderstaande macro zou ik alleen willen uitvoeren als het werblad "xxx" bestaat:

Sub Groepengenererenwissen()
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = True
  Application.StatusBar = "Bezig met verwijderen van groepen...."
    With Sheets("xxx")
        .Unprotect
        .Range("AO3:AZ50000").ClearContents
        .Protect AllowFiltering:=True
    End With
  Application.ScreenUpdating = True
  Application.StatusBar = False
End Sub

Probleem is namelijk dat deze macro bij bestand sluiten automatisch wordt uitgevoerd, als het blad niet meer bestaat krijg ik een foutmelding.

Wie weet raad?

 

[zapatr]

Dat kan zo:

Sub Groepengenererenwissen()
dim x as integer
For x = 1 To Sheets.Count
If Sheets(x).Name = "xxx" Then
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Bezig met verwijderen van groepen...."
With Sheets("xxx")
.Unprotect
.Range("AO3:AZ50000").ClearContents
.Protect AllowFiltering:=True
End With
Application.ScreenUpdating = True
Application.StatusBar = False
End If
Next x
End Sub

Maar je schrijft dat die macro automatisch wordt uitgevoerd bij het sluiten van de map. Dan moet die macro door een andere macro worden aangeroepen (door een "Private Sub Workbook_BeforeClose-macro veronderstel ik). Je kunt dan ook best al in die macro kijken of het blad bestaat en niet in de hier geplaatste macro, aldus:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
dim x as integer
For x = 1 To Sheets.Count
If Sheets(x).Name = "xxx" Then
Groepengenererenwissen
End If
Next x
end sub

 

[Niels28]

Plaats deze in een standaardmodule

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function

Gebruik hem in je macro als

If Not WorksheetExists("Werkbladnaam hier invullen") Then Exit Sub

 

[oceanrace]

Bedankt voor jullie hulp.

Mijn private sub ziet er zo uit.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As String

Application.EnableEvents = False
       If MsgBox("Klik op het XPS of XLS icoon voor opslaan als, alleen het actieve werkblad " & vbCrLf & _
        "wordt dan opgeslagen als .XPS, vergelijkbaar met .PDF, of .XLS bestand zonder formules!" & vbCrLf & _
        "" & vbCrLf & _
        "" & vbCrLf & _
        "Let op: Klik alleen op OK als je het origineel wilt vervangen!", vbExclamation + vbOKCancel + vbDefaultButton2, "Beveiliging origineel bestand") = vbOK Then
                
                Cancel = False
                 Run "Groepengenererenwissen"
            Else
                Cancel = True
            End If
    Application.EnableEvents = True
End Sub

 

[oceanrace]

Ik heb de code van zapatr overgenomen:

Sub Groepengenererenwissen()
dim x as integer
For x = 1 To Sheets.Count
If Sheets(x).Name = "xxx" Then
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Bezig met verwijderen van groepen...."
With Sheets("xxx")
.Unprotect
.Range("AO3:AZ50000").ClearContents
.Protect AllowFiltering:=True
End With
Application.ScreenUpdating = True
Application.StatusBar = False
End If
Next x
End Sub

En mijn private sub zoals hieronder laten staan:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As String

Application.EnableEvents = False
       If MsgBox("Klik op het XPS of XLS icoon voor opslaan als, alleen het actieve werkblad " & vbCrLf & _
        "wordt dan opgeslagen als .XPS, vergelijkbaar met .PDF, of .XLS bestand zonder formules!" & vbCrLf & _
        "" & vbCrLf & _
        "" & vbCrLf & _
        "Let op: Klik alleen op OK als je het origineel wilt vervangen!", vbExclamation + vbOKCancel + vbDefaultButton2, "Beveiliging origineel bestand") = vbOK Then
                
                Cancel = False
                 Run "Groepengenererenwissen"
            Else
                Cancel = True
            End If
    Application.EnableEvents = True
End Sub

Het lijkt nu goed te gaan.
Bedankt voor jullie hulp!

 

[zapatr]

oceanrace,
markeer je vraag nog even als "Opgelost" a.u.b.