【excel怎么解密宏】破解excel密码最可靠的方法

EXCEL是我们工作中非常能干的助手。特别是一些函数公式大大方便了我的数据统计、计算等。看一些高手制作的带有函数公式的EXCEL表，也可以帮助你学习EXCEL的知识，但是一些高手制作的表是加密的，根本看不到是怎么计算的。所以我们想去掉密码。现在，我将分享裂缝的过程。

打开需要解密的EXCEL表单。

单击“工具”—“宏”—“录制新宏”。默认宏名称为Macrol。单击“确定”。

单击停止按钮。

在菜单栏中，依次单击“工具”-“宏”，然后选择刚才录制的宏。默认宏名称为Macrol。请点击右边的编辑按钮。

清空编辑框中的所有内容。

将以下代码复制到编辑框中：

Option Explicit

Public Sub AllInternalPasswords()

breaks worksheet and workbook structure passwords . bob McCormick

probably originator of base code algorithm modified for coverage

of workbook structure/windows passwords and for multiple passwords

`

Norman harker and je mcgimpsey 27-dec-2002(版本1.1)

modified 2003-apr-04 by JEM 3360 all msgs to constants，and

Eliminate one exit sub(版本1.1.1)

reveals hashed passwords not original passwords

const dbl space asstring=VB newline VB newline

const authors as string=dbl space vbnewline _

adapted from bob McCormick base code by ' _

《Norman Harker and JE McGimpsey》

const header asstring=' all internal passwords user message '

Const version as string=dbl space '版本1.1.1 2003-apr-04 '

const rep back as string=dbl space ' please report failure ' _

To the micro newsgroup。'

const all clear as string=dbl space ' the workbook should ' _

now be free of all password protection，so make sure you 3360' _

DBLSPACE 'SAVE IT NOW！'DBLSPACE 'and also' _

DBLSPACE 'BACKUP！备份！备份！”_

Dbl空间' also，remember that the password was' _

put there for a reason . don ' t stuff up crucial formulas ' _

Or data。dbl space ' access and use of some data ' _

May be an offense。if in doubt，don' T . '

constmsgnopwords 1 asstring=' there were no passwords on ' _

Sheets，or workbook structure

or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
"Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
"Note it down for potential future use in other workbooks by " & _
"the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The password found was: " & _
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
"future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _
"other passwords." & AUTHORS & VERSION
Const MSGONLYONE As String = "Only structure / windows " & _
"protected with the password that was just found." & _
ALLCLEAR & AUTHORS & VERSION & REPBACK
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

A = 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
MsgBox MSGNOPWORDS1, vbInformation, HEADER
Exit Sub
End If
MsgBox MSGTAKETIME, vbInformation, HEADER
If Not WinTag Then
MsgBox MSGNOPWORDS2, vbInformation, HEADER
Else
On Error Resume Next
Do 'dummy do loop
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)
MsgBox A(MSGPWORDFOUND1, _
"$$", PWord1), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
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
MsgBox MSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
'Checks for all clear ShTag triggered to 1 if not.
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 'Dummy do loop
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)
MsgBox A(MSGPWORDFOUND2, _
"$$", PWord1), vbInformation, HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do 'Bypass all for...nexts
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
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub

点击工具栏内的运行按钮。选运行子过程/用户窗体。

跳出对话框后点击确定，稍后再次跳出对话框后再次点击确定。

稍等一会儿，跳出密码。注意：这个密码并不是原作者设定的密码，但是确实可以用，可原密码无异。

点击确定，然后会自动备份一个不加密的文件出来。

破解完成。

下面我就用一动图来破解一个开关电源的变压器计算的EXCEL表格来给大家演示。