本文目录一览：
- 1、如何破解excel宏的密码
- 2、如何破解excel宏密码的方法
- 3、Excel中的xlsm宏密码怎么破解
- 4、Excel宏加密后,无论创建、删除还是编辑均需密码,如何破解
- 5、如何破解Excel宏密码?
如何破解excel宏的密码
打开文档后，通过文件菜单中“另存为”，将文档存为rtf格式。保存好文件后，先关掉文档再打开另存的文件，选择工具栏中的“解除文档保护”命令，不用填写密码就可以解除此文件的“文档保护功能”，而且任何信息都不会丢失。用Office Password Remover这个软件可以打开。
使用方法：
首先运行解压好的OPRemove.exe 这个程式，打开程式后能看到中间文本框后面有个类似目录的按钮。
选择后出现下图的画面，点击移除密码。
呆几秒钟后便出现“该文件已被成功破解”，点确定即可，这时候就大功告成了。 在这里要注意的是，破解后的文章名字会有点变化，加了“DEMO”这四个字母，翻译过来就是示范的意思，不必在意，重命名去掉就能了。
如何破解excel宏密码的方法
如何破解excel宏密码的方法：
破解宏密码步骤1：打开需要破解的文件，并点开需要输入密码的界面，如图
破解宏密码步骤2：使用EXCEL.EXE重新打开一个工作簿。
破解宏密码步骤3：打开新工作簿的VBA代码区域，并插入一个模块。
破解宏密码步骤4：插入如下代码
Sub test()
Dim st, nd, th3, th4, th5, th6, th7, th8 As Variant
Dim ii, jj, kk, ll, mm, nn, oo, pp, qq As Integer
Dim PADN, PD, IJ, JK, PADNO, speed
speed = 0.005
st = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
nd = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
th3 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
th4 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
th5 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
th6 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
th7 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
th8 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
PADN = InputBox("How long the password is", "Guilin Hu", 4)
PADNO = CInt(PADN)
For IJ = 1 To 100
If Sheet1.Cells(IJ, 1) = "" Then
Sheet1.Cells(IJ, 1) = Now
Exit For
Else
End If
Next IJ
PauseTime = 2
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
Select Case (PADNO)
Case 1
For ii = 0 To 61
PD = st(ii)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next ii
Case 2
For ii = 0 To 61
For jj = 0 To 61
PD = st(ii) nd(jj)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next jj
Next ii
Case 3
For ii = 0 To 61
For jj = 0 To 61
For kk = 0 To 61
PD = st(ii) nd(jj) th3(kk)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next kk
Next jj
Next ii
Case 4
For ii = 0 To 61
For jj = 0 To 61
For kk = 0 To 61
For ll = 0 To 61
PD = st(ii) nd(jj) th3(kk) th4(ll)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next ll
Next kk
Next jj
Next ii
Case 5
For ii = 0 To 61
For jj = 0 To 61
For kk = 0 To 61
For ll = 0 To 61
For mm = 0 To 61
PD = st(ii) nd(jj) th3(kk) th4(ll) th5(mm)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next mm
Next ll
Next kk
Next jj
Next ii
Case 6
For ii = 0 To 61
For jj = 0 To 61
For kk = 0 To 61
For ll = 0 To 61
For mm = 0 To 61
For nn = 0 To 61
PD = st(ii) nd(jj) th3(kk) th4(ll) th5(mm) th6(nn)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next nn
Next mm
Next ll
Next kk
Next jj
Next ii
Case 7
For ii = 0 To 61
For jj = 0 To 61
For kk = 0 To 61
For ll = 0 To 61
For mm = 0 To 61
For nn = 0 To 61
For oo = 0 To 61
PD = st(ii) nd(jj) th3(kk) th4(ll) th5(mm) th6(nn) th7(oo)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next oo
Next nn
Next mm
Next ll
Next kk
Next jj
Next ii
Case 8
For ii = 0 To 61
For jj = 0 To 61
For kk = 0 To 61
For ll = 0 To 61
For mm = 0 To 61
For nn = 0 To 61
For oo = 0 To 61
For pp = 0 To 61
PD = st(ii) nd(jj) th3(kk) th4(ll) th5(mm) th6(nn) th7(oo) th8(pp)
SendKeys PD
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
PauseTime = speed
Start = Timer
Do While Timer Start + PauseTime
DoEvents
Loop
Finish = Timer
SendKeys "{enter}"
Next pp
Next oo
Next nn
Next mm
Next ll
Next kk
Next jj
Next ii
End Select
For JK = 1 To 100
If Sheet1.Cells(JK, 2) = "" Then
Sheet1.Cells(JK, 2) = Now
Exit For
Else
End If
Next JK
End Sub
破解宏密码步骤5：按F5执行代码，输入密码长度。如果不知道密码的长度，就猜，第一次输1，第二次输2。。。依次试。
破解宏密码步骤6：输入密码长度后，点击确定。并在2s内将鼠标的焦点点在最开始要破解文件的密码输入框里边。接下来的工作就是“静候佳音”了。
破解宏密码步骤7：没有破解不开的密码。主要的是你有时间就好!1位密码破解最长时间：62/(1/0.005)=0.31秒;2位数密码破解最长时间：62*62/(1/0.005)=19.22秒。。。依次类推：N位数密码破解时间：(62)的N次方/(1/0.005)秒的时间。就看您的耐性了!破解完成之后就会自动进去VBA代码模块。
破解宏密码步骤8：接下来就是修改别人的密码了!进去果断点击VBA工程属性，改密码。
Excel中的xlsm宏密码怎么破解
首先，先去下载一款代码编辑器Notepad++
第二步，将待破解的档案后缀名称由.xlsm改为.rar或者.zip
第三步，使用压缩软件打开，进入xl目录找到vbaProject.bin文件
右键【打开】，选择已下载好的代码编辑器Notepad++
第四步，查找字符DPB并将其替换成DPx，保存文件，确定更新，关闭压缩档案，再重新修改后缀名.rar(或者是.zip)为.xlsm
第五步，使用excel打开.xlsm文件，弹出警告框，点击“是”，【开发工具】，【查看代码】，弹出未知错误提示框，点击“确定”。【工具】菜单，【VBAProject属性】打开工程属性，切换到【保护】标签，重新填入密码或者不填写密码（不填写密码时不要勾选查看是锁定工程），最后确定。
最后，保存后关闭档案，重新打开档案就可以看到里面的代码了
PS. 破解仅用来学习，但不要挡了别人的财路
Excel宏加密后,无论创建、删除还是编辑均需密码,如何破解
1、我新建一个excel文件（.xlsx格式的）来测试破解过程，其它文件可以参考，但最好要备份原来的文件,设置工作表、工作薄为密码保护，保存后
2、打开电脑上的压缩软件，然后在菜单里选择打开压缩包，进入excel文件所在的目录，按图2所示，找到excel文件，然后打开,打开后的界面如下图3所示
3、下面介绍一下删除工作薄的密码，如下图红色箭头所指的文件，用内部阅读器打开
4、搜索，打开搜索界面，搜索“workbookProtection”，如下图所示，把该标签的内容全部删除，删除后如图2所示
5、保存修改到压缩，如图2所示
6、下面介绍一下删除工作表的密码，如下图红色箭头所指的文件，用内部阅读器打开,打下面的文件
7、打开后，搜索“sheetProtection ”，删除整个标签的内容，保存到压缩包
8
8、关掉压缩包，重新打开那个测试的excel文件，可以看到密码保护已经没有了
如何破解Excel宏密码?
方法:
1\打开文件
2\工具---宏----录制新宏---输入名字如:aa
3\停止录制(这样得到一个空宏)
4\工具---宏----宏,选aa,点编辑按钮
5\删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧)
6\关闭编辑窗口
7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!!
内容如下：
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 (Version 1.1)
' Modified 2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub (Version 1.1.1)
' Reveals hashed passwords NOT original passwords
Const DBLSPACE As String = vbNewLine vbNewLine
Const AUTHORS As String = DBLSPACE vbNewLine _
"Adapted from Bob McCormick base code by" _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE "Please report failure " _
"to the microsoft.public.excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE "The workbook should " _
"now be free of all password protection, so make sure you:" _
DBLSPACE "SAVE IT NOW!" DBLSPACE "and also" _
DBLSPACE "BACKUP!, BACKUP!!, BACKUP!!!" _
DBLSPACE "Also, remember that the password was " _
"put there for a reason. Don't stuff up crucial formulas " _
"or data." DBLSPACE "Access and use of some data " _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "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
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
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 Application.Substitute(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 Application.Substitute(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