Abra o editor de vba (alt+F11), insira um modulo e cole
este código, feche o editor de VBA e clique em ferramentas - macro - macros e
desproteger, execute, espere o programa varrer sua senha e assim você poderá
utilizar a planilha novamente.
**Obs. Em tópicos futuros ensinaremos a salvar seus arquivos como
suplementos.**
Sub
desproteger()
'O que
você quer, aqui você pode
'Modulo para desproteger suas planilhas de excel.
Dim i As Integer, j As Integer, k As
Integer
Dim l As
Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As
Integer, i6 As Integer
On Error Resume Next
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
ActiveSheet.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
ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " &
Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) &
Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) &
Chr(i6) & Chr(n)
Exit Sub
End If
Next:
Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
Dúvidas? Deixe comentário.
23 comentários:
olá bom dia!!!
não consigo desproteger minha planilha, usei os exemplos mas mesmo assim não consegui executar.
tem como simplificar?
muito grato>.
SAYMO SILVA
Sua planilha pode estar protegida em tempo de execução, isso quer dizer que deve haver dentro de algum módulo uma macro de proteção. Resumindo, dentro do vba aperte Ctrl + u e faça uma busca no projeto atual pela palavra "protect". Esta palavra após localizada vai te mostrar o que estão fazendo para proteger a planilha.
Bom dia,
Eu também copiei e colei o código, mas para funcionar precisa dar uma ajustada, porque quando copia e cola fica desfigurado.
Fiz isso e funcionou!
Sergio
Oi tudo bem, gostaria de saber...
Montei uma pasta de excel utilizando o vba e coloquei uma senha no vba, mas eu esquici a senha, gostaria de saber se tem alguma dica para desproteger não a planilha e sim o vba ???
Abraços
Rodrigo
funcionou muito bem a macro, valeu!
Excelente dica. Para quem achar complicado, ou então a senha for para abrir a planilha, recomendo o site http://www.senhaperdida.com.br
Olá,
Para quem não conseguir remover a senha com esta dica: http://www.senhaperdida.com.br
Olá, ótima dica para a senha VBA.
Com a devida autorização do Administrador, gostaria de indicar um site para aqueles que estão precisando remover a senha para ABRIR planilhas: http://www.senhaperdida.com.br. Obrigado.
Mesmo sendo um post bem antigo, gostaria de agradecer pelo envio... Funcionou perfeitamente o desbloqueio.
Abs,
Fabricio
No meu caso aqui, quando abro vba, não consigo inserir nenhum código, ele pede logo uma senha, tem algum jeito nesse caso?
Wesley
Essa dica funciona muito bem na grande maioria das vezes, mas algumas vezes não dá certo mesmo. Procurando outra solução acabei encontrando este site: http://www.senhaperdida.com.br. Eles dizem que desbloqueiam em qualquer caso, mas não cheguei a testar o serviço.
Fiz exatamente como descrito e ocorreu a seguinte frase:
"Erro de compilação: Era esperado: Identificador."
Excelente dica para a senha que protege as células da planilha. Se o problema for remover a senha de abertura, recomendo o site http://www.senhaperdida.com.br. É barato e removem a senha rapidamente.
Excelente...
Desprotegi e ainda vi a senha anterior..
Houve um comentario acima, que a pessoa não conseguiu. Talvez por que, quando colou o codigo, saiu desformatado, como aconteceu comigo, mas coloquei em ordem...
Tento fazer como esta dito mas quando tento acessar a ferramenta 'INSERIR' as opções estão bloqueadas, não posso selecionar elas por isso comigo ñ funcionou.
Quem puder me ajude por favor e mande pra mim por email
eba_12@hotmail.com Obrigado.
Tento fazer como esta dito mas quando tento acessar a ferramenta 'INSERIR' as opções estão bloqueadas, não posso selecionar elas por isso comigo ñ funcionou.
Quem puder me ajude por favor e mande pra mim por email
eba_12@hotmail.com Obrigado.
Excelente Post. Resolveu o problema 100%. Obrigado.
Olá, só para agradecer... Também funcionou para mim. Obrigado!
Ricardo Langner
Private Sub DesprotegeVBA()
'-------------------------------------------------------------------
' Função para desproteger a senha do VBA
' Tradução by VenonStorm
'-------------------------------------------------------------------
Dim F As String ' conterá nome do arquivo a ser craqueado
Dim B As String
Dim NewF As String 'Nom de copie de secours
Dim NbTour As Long
Dim Ok As Boolean 'marcador
Dim Pointeur As Long 'Posição do ponteiro
Dim Nb As Long
Dim LgFile As Long
Dim Cle As Integer 'Chave
Dim p1 As Long, p2 As Long, p3 As Long 'posicionar no começo chave
Dim p11 As Long, p22 As Long, p33 As Long 'posicionar no final da chave
'Abrir arquivo
F = "F:meus documentosExcelExcelTrek.xls" '==> ATENÇÃO: colocar aqui o NOME E CAMINHO do arquivo que contém a senha
If F = "" Then Exit Sub 'verifica se o arquivo foi especificado
NewF = F & ".tmp"
If Dir(NewF) <> "" Then ' verifica se o arquivo já existe
Kill NewF
End If
Call CopyFile(F, NewF) 'Cria um arquivo de backup
'Desprotege a senha do VBA
B = String$(512, " ")
Open F For Binary As #1
LgFile = LOF(1)
Cle = 0
Do
Pointeur = Loc(1) 'posiciona o ponteiro
Get #1, , B
'Chave da busca CMG="
p1 = InStr(1, B, "CMG=" & Chr$(34), vbBinaryCompare)
If p1 <> 0 Then
'citação da busca - marcas do fechamento
p11 = InStr(p1 + 5, B, Chr$(34), vbBinaryCompare)
If p11 <> 0 Then 'apaga a chave
Mid(B, p1, p11 - p1 + 1) = Space$(p11 - p1 + 1)
Ok = True
Cle = Cle + 1
End If
End If
'Chave da busca DPB="
p2 = InStr(1, B, "DPB=" & Chr$(34), vbBinaryCompare)
If p2 <> 0 Then
'citação da busca - marcas do fechamento
p22 = InStr(p2 + 5, B, Chr$(34), vbBinaryCompare)
If p22 <> 0 Then 'apaga a chave
Mid(B, p2, p22 - p2 + 1) = Space$(p22 - p2 + 1)
Ok = True
Cle = Cle + 1
End If
End If
'Chave da busca GC="
p3 = InStr(1, B, "GC=" & Chr$(34), vbBinaryCompare)
If p3 <> 0 Then
'citação da busca - marcas do fechamento
p33 = InStr(p3 + 5, B, Chr$(34), vbBinaryCompare)
If p33 <> 0 Then 'apaga a chave
Mid(B, p3, p33 - p3 + 1) = Space$(p33 - p3 + 1)
Ok = True
Cle = Cle + 1
End If
End If
If Ok Then 'gravar o bloco
Put #1, Pointeur + 1, B
Ok = False
End If
'se as 3 chaves foram apagadas => para a busca
If Cle = 3 Then Exit Do
'mover para trás de 100 bytes para evitar um corte
Seek #1, Loc(1) - 99
Loop Until Pointeur > LgFile
Close #1
'Mensagem
Select Case Cle
Case 0
Kill NewF
MsgBox "Não foi detectada proteção"
Case 1, 2
MsgBox "Operação incompleta, arquivo incompatível " & _
vbCrLf & vbCrLf & "Arquivo de backup: " & vbCrLf & vbCrLf & NewF
Case 3
MsgBox "Operação concluída com sucesso!!!"
End Select
End Sub
Private Sub CopyFile(Ancien As String, Nouveau As String, Optional Suppr As Boolean)
'Cria um arquivo de backup
Dim B As String
Dim NbTour As Long
Dim Nb As Long
Open Ancien For Binary As #1
Open Nouveau For Binary As #2
B = String$(512, " ")
NbTour = LOF(1) 512
Do
If Nb = NbTour Then
B = String$(LOF(1) - NbTour * 512, " ")
ElseIf Nb > NbTour Then
Exit Do
End If
Nb = Nb + 1
Get #1, , B
Put #2, , B
Loop
Close #1
Close #2
If Suppr = True Then Kill Ancien
End Sub
Private Sub CommandButton1_Click()
DesprotegeVBA
End Sub
Olá.
Pra mim da o erro na seguinte expressão:
Open Ancien For Binary As #1
Valeu Bruno, a dica funcionou, mas tive que que retirar o comando para a rotina de backup, pois a linha "NbTour = LOF(1) 512" estava gerando um erro de compilação.
Valeu Bruno, a dica funcionou, porém foi necessário desabilitar a rotina para criar um backup, pois a linha "NbTour = LOF(1) 512" estava gerando um erro de compilação.
bRUNO EXPLIQUE-SE MELHOR, NÃO ENTENDÍ ONDE COLAR ESTA FUNÇÃO
Postar um comentário