VBA Excel - Protege e Desprotege todas as planilhas - Protect and Unprotect all Worksheets

Termo de Responsabilidade 

Quando entregamos alguns dos nossos trabalhos, desejamos fazê-lo de um modo que permaneçam intactos até que este chegue às mãos daquele que nos solicitou. Muito provavelmente já deparou-se com a seguinte situação:

Um dos seus Clientes (que lhe solicitou uma solução, e quem você havia pessoalmente entrevistado antes do desenvolvimento), pediu para que um assessor dele pudesse dar uma olhada no Dashboard, Scorecard ou Report, que você preparou, antes que ele mesmo o fizesse. 

O intuito do Cliente é oportuno, afinal de contas alguém pode poupar-lhe o tempo, por limar quaisquer aspectos que não estiverem em conformidade com o solicitado. Mas..., sempre tem um 'mas'. Aquele assessor dedicado, sabendo dos gostos tais como fonte, cores, tamanhos que o seu chefe gosta, decide aplicá-los a sua solução, sem ao menos imaginar que você mesmo já teve um todo um trabalho para harmonizar as cores, o ambiente e logomarca. Como impedir este auxiliares de comprometerem a Identidade Visual que você definiu?

Calma pessoal, não precisamos desenvolver nada que eletrifique o assessor do nosso Cliente. Apenas vamos proteger todas as planilhas com uma senha que somente será divulgada ao nosso Cliente final, e esta lhe será informada alertando-o antecipadamente das responsabilidades inerentes.

Existe código prá isso? Sim, divirta-se!

Sub ProtectAllWorksheets()

' Função que protege todas as planilhas de um arquivo

    Dim lPass As String

    Dim lQtdePlan As Integer

    Dim lPlanAtual As Integer

    'Solicita a senha

    Let lPass = InputBox("Proteger todas as planilhas:", "Senha", ActName)

    'Inicia as variáveis

    Let lQtdePlan = Worksheets.Count

    Let lPlanAtual = 1

    'Loop pelas planilhas

    While lPlanAtual <= lQtdePlan

        'O método Worksheets(lPlanAtual).Activate ativa a planilha conforme o índice atual 1, 2, 3...

        Worksheets(lPlanAtual).Activate

        'O método .Protect proteje a planilha passando os parâmetros para proteger

        'objetos de desenho, conteúdo, cenários e passando o password digitado

        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=lPass

        'Muda o índice para passar para a próxima planilha

        Let lPlanAtual = lPlanAtual + 1

    Wend

    'O método MsgBox exibe um formulário de aviso ao usuário.

    MsgBox "Planilhas protegidas!"

End Sub

E como faço para desproteger?

Sub UnProtectAllWorksheets()

    ' Função que desprotege todas as planilhas de um arquivo

    Dim lPass As String

    Dim lQtdePlan As Integer

    Dim lPlanAtual As Integer

    'Solicita a senha

    Let lPass = InputBox("Desproteger todas as planilhas:", "Senha", ActName)

    'Inicia as variáveis

    Let lQtdePlan = Worksheets.Count

    Let lPlanAtual = 1

    'Loop pelas planilhas

    While lPlanAtual <= lQtdePlan

        'O método Worksheets(lPlanAtual).Activate ativa a planilha conforme o índice atual 1, 2, 3...

        Worksheets(lPlanAtual).Activate

        'O método .UnProtect desprotege a planilha

        ActiveSheet.Unprotect Password:=lPass

        'Muda o índice para passar para a próxima planilha

        Let lPlanAtual = lPlanAtual + 1

    Wend

    'O método MsgBox exibe um formulário de aviso ao usuário.

    MsgBox "Planilhas desprotegidas!"

End Sub

Veja também: MS Excel – Diversas Funções Úteis.

References: Guiadoexcel.com.br

Tags: VBA, Office, Excel, protect, unprotect, proteger, desproteger

VBA Excel - Desbloqueando as worksheets com VBA (How to hack a lost worksheet password with VBA to unprotect the worksheet)

| Blog Office VBA | Blog Excel | Blog Access |

Por estarmos envolvidos em tantos projetos simultaneamente, não raro acontece de esquecermos as senhas de proteção das worksheets. Neste momento saimos correndo atrás de programas que possam desbloquear nossas planilhas. Abaixo está um bem estruturado código capaz de retirar a proteção das nossas woksheets. É uma implementação válida e digna de ficar sempre à mão. Agora poderá a qualquer momento copiá-la daqui e implementá-la em sua planilha para o pronto desbloqueio. Use a chamada para evocar a solução:

Call AllPasswordsRemover(ActiveWorkbook)

Public Sub AllPasswordsRemover(wb As Workbook)
 Dim w1 As Worksheet Dim w2 As Worksheet
 Dim i As Integer Dim j As Integer Dim k As Integer
 Dim l As Integer Dim m As Integer Dim n As Integer
 Dim i1 As Integer Dim i2 As Integer Dim i3 As Integer
 Dim i4 As Integer Dim i5 As Integer Dim i6 As Integer
 Dim PWord1 As String Dim ShTag As Boolean
 Dim WinTag As Boolean ' Início da tentativa de desproteger o wb (workBook), Application.ScreenUpdating = False ' Verifica se está protegido With wb Let WinTag = .ProtectStructure Or .ProtectWindows End With Let ShTag = False ' Estão realmente protegidos? For Each w1 In Worksheets Let ShTag = ShTag Or w1.ProtectContents Next w1 ' Caso não haja proteção, o processo é encerrado! If Not ShTag And Not WinTag Then GoTo exx End If ' Dependendo da senha e de quantas planilhas estiverem protegidas com diferentes senhas, ' o processo talvez leve um tempo considerável. Estimo entre 3-6 minutos por senha. If Not WinTag Then ' Workbook não está protegido... vai checar as planilhas... Else ' Workbook está protegido, desprontegendo-o On Error Resume Next Do For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 With wb .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _ .ProtectWindows = False Then Let PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ' Achamos o password para este workbook. MsgBox "A Worksheet '" & w1.Name & "' foi desprotegida usando o seguinte hash " & _ "Hashed Password:" & Chr(13) & PWord1 & Chr(13) & "Tente desproteger outras " & _ "planilhas com este mesmo password..." Exit Do End If End With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If If WinTag And Not ShTag Then ' Worksheets Não estão protegidas. GoTo exx End If ' Caso as worksheets estiverem protegidas... On Error Resume Next For Each w1 In Worksheets w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag = False ' Checa se a tentativa foi bem sucedida. For Each w1 In Worksheets ' Checa para todas as ShTag engatilhadas para 1, se não. Let ShTag = ShTag Or w1.ProtectContents Next w1 ' Caso haja worksheet protegida, desprotege-a. If ShTag Then For Each w1 In Worksheets With w1 If .ProtectContents Then On Error Resume Next Do For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ' Achamos 1! MsgBox "A Worksheet '" & w1.Name & "' foi desprotegida usando o seguinte hash " & _ "Hashed Password:" & Chr(13) & PWord1 & Chr(13) & "Tente desproteger outras " & _ "planilhas com este mesmo password..." For Each w2 In Worksheets w2.Unprotect PWord1 Next w2 Exit Do End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 Else Debug.Print ("Estas worksheets '" & w1.Name & "' não estavam protegidas.") End If End With Next w1 End If GoTo exx exx: Application.ScreenUpdating = True
End Sub

 Para os que desejarem aprofundar-se na lógica do como foi possível chegar a este resultado poderão fazê-lo Aqui.