Excel: Jak odemknout zamčené záložky

Hodnocení uživatelů:  / 4

Podrobnosti

Zveřejněno 7. 2. 2010 20:00

Napsal mike007

Zobrazeno: 31932

V tomto článku uvedu makro, které dokáže během několika málo vteřin odemknout uzamčené listy proti úpravám. Než Vám zde začnu popisovat kroky k prolomení hesel v Excelu, musím Vás upozornit, že uvedený návod slouží pouze pro prolomení hesel ve vámi vytvořených dokumentech. Za prolamování hesel v cizích dokumentech, které mají obsah uzamčený z nějakého důvodu (autorská práva, školní data atp.) neberu žádnou zodpovědnost!

1. Otevřete Excelový dokument s uzamčeným obsahem a v něm spusťe prostředí VBA [návod]

2. Do nově vytvořeného modulu nakopírujte toto makro:

Public Sub zlomit_heslo()
Dim w1 As Worksheet, w2 As Worksheet
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
Dim PWord1 As String
Dim ShTag As Boolean, WinTag As Boolean
Const DBLSPACE As String = vbNewLine & vbNewLine
' === potvzení ===
If MsgBox("Spustit makro?", vbYesNo, "Potvrzení") <> vbYes Then Exit Sub
' === informační okno ===
MsgBox "Odemknutí záložek bude chvíli trvat. " & DBLSPACE & _
"Záleží na počtu vložených hesel a jak výkonný je Váš počítač ... " & DBLSPACE & _
"Stiskem tlačítka OK zahájíte činnost makra"
Application.ScreenUpdating = False
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
Next w1
If Not ShTag And Not WinTag Then
Exit Sub
End If
If Not WinTag Then
Else
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 ActiveWorkbook
.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
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)
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
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
Next w1
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)
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
End If
End With
Next w1
End If
Application.ScreenUpdating = True
' === informační okno - úspěšně dokončení ===
MsgBox "Všechna hesla byla v tomto dokumentu zlomena!"
End Sub

3. Prostředí VBA zavřete a spusťte makro (Nástroje --> Makro ---> Makra... --> vyberte makro "zlomit_heslo" a klikněte na tlačítko Spustit)

4. Potvďte spuštění makra kliknutím na tlačítko ANO.

5. Informační tabulku zavřete tlačítkem OK.

Od tohoto okamžiku pracuje makro. Nikam neklikejte a nepřepínejte okna!

Po úspěšném prolomení hesla budete informováni.

Dokument s makrem si můžete stáhnout ZDE

Tak ať slouží.

Autor: Michael Ruprecht (mike007)

Myslíte si, že je článek užitečný?
Proč se tedy o něj nepodělit se svými přáteli na Facebooku ;) Děkujeme.