Kod ten chroni wszystkie arkusze z wyjątkiem jednego arkusza. Działa to, jeśli arkusze są chronione, ale podaje mi komunikat o błędzie, gdy nie są chronione.

WS jest arkuszem, na którym znajduje się przycisk.

WHEEK to ochrona wszystkich arkuszy z wyjątkiem tego, że jeden arkusz. Zasadniczo, gdy użytkownik kliknie przycisk WS WS, chcę, aby wszystkie arkusze (w tym jeden przycisk jest włączony), aby być chronionym, z wyjątkiem arkusza o nazwie "Nadgodziny". Po ponownym kliknięciu na to, niech do niego niechętnie.

Dim wSheet As Worksheet
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)


        Application.ScreenUpdating = False

            For Each wSheet In Worksheets
                If wSheet.Name = "Overtime" Then
                    wSheet.Unprotect Password:="12345"
                    ws.Shapes("Rectangle_LOCK").TextFrame.Characters.Text = "Vérouiller" 'THIS IS WHERE IT GIVES ME THE ERROR
                ElseIf wSheet.ProtectContents = True Then
                    wSheet.Unprotect Password:="12345"
                    ws.Shapes("Rectangle_LOCK").TextFrame.Characters.Text = "Vérouiller"
                Else

                    wSheet.Unprotect Password:="12345"
                    ws.Shapes("Rectangle_LOCK").TextFrame.Characters.Text = "Déverouiller"
                    wSheet.Protect Password:="12345"


                End If
            Next wSheet

 Application.ScreenUpdating = True
0
Jade 19 marzec 2020, 18:01

1 odpowiedź

Najlepsza odpowiedź

Wypróbuj poniższy kod ...

Dim wSheet As Worksheet
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets(1)


Application.ScreenUpdating = False

For Each wSheet In wb.Worksheets
    If wSheet.Name <> "Overtime" Then
        If wSheet.ProtectContents Then
            wSheet.Unprotect Password:="12345"
            If wSheet.Name = ws.Name Then
                wSheet.Shapes("Rectangle_LOCK").TextFrame.Characters.Text = "Vérouiller"
            End If
        Else
            If wSheet.Name = ws.Name Then
                wSheet.Shapes("Rectangle_LOCK").TextFrame.Characters.Text = "Déverouiller"
            End If
            wSheet.Protect Password:="12345"
        End If
    End If
Next wSheet

Application.ScreenUpdating = True
1
Domenic 19 marzec 2020, 16:47