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.
