破解excel密码宏程序代码

ex-vba迄今为止最简单的excel工作表密码解除方法

ex-vba迄今为止最简单的excel工作表密码解除方法
『动画解读』
对于设置了工作表密码的工作簿，打开后，具体操作步骤如下：
Step-01：通过菜单【开发工具】-【Visual Basic】进入VBA 编辑界面
Step-02：在VBA编辑窗口的【立即窗口】中逐步执行以下代码（输完一句回车后再输入另一句并回车其中sheet1为需要破解密码的工作表的名称）sheet1.Protect AllowFiltering:=truesheet1.unProtect
逐步执行这两行代码后，工作表的密码将被解除！！！
如果打开VBA编辑窗口时没有立即窗口，可以通过菜单【视图】-【立即窗口】调出来，如下图所示：
『扩展应用』如果需要批量解除的，可以自行加入循环控制语句，写成一个过程。

代码参考如下（将代码复制放在ThisWorkbook下，然后运行）：Sub clsWkShtPwd() Dim sht As Worksheet For Each sht In Worksheets
sht.Protect AllowFiltering:=True sht.unprotect NextEnd Sub
在此再次感谢大神们的分享！同时，一门技术是好是坏，全凭个人掌握，用于益处是为好……。

如何利用VBA实现Excel数据加密与解密

如何利用VBA实现Excel数据加密与解密在Excel中，数据加密与解密是非常重要的功能，可以保护敏感数据的安全性。

VBA（Visual Basic for Applications）是一种编程语言，可以在Excel中编写宏来实现各种功能。

利用VBA编写代码可以实现Excel数据的加密与解密操作，本文将介绍如何利用VBA实现Excel数据的加密与解密。

首先，我们需要创建一个新的Excel工作簿，并通过VBA 编辑器添加一个新的模块。

在模块中编写以下代码：```VBAPrivate Sub EncryptData(ByVal rng As Range, ByVal password As String)rng.Formula = "=ENCRYPT.DECRYPT(" & rng.Address & "," & """" & password & """" & ",TRUE)"End SubPrivate Sub DecryptData(ByVal rng As Range, ByVal password As String)rng.Formula = "=ENCRYPT.DECRYPT(" & rng.Address & "," & """" & password & """" & ",FALSE)"End Sub```上述代码中，`EncryptData`是加密数据的函数，接受两个参数：`rng`是要加密的数据范围，`password`是加密密码。

破解excel保护密码破解vbaproject密码

破解excel保护密码破解vbaproject密码破解excel保护密码破解vbaproject密码破解excel保护密码破解vbaproject密码破解vbaproject密码1．打开带密码的Excel,视图---宏----录制宏---（保存到）“个人宏工作簿”---点“确认”。

2．查看宏----点“编辑”-----进入“Microsofe visual basic-PERSONAL.XLSB”页面；3．点“模块1“，弹出“模块1代码”----清除“模块1代码”里面的东西-----复制如下东西：Public Sub 工作表保护密码破解() Const DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _"作者:McCormick JE McGimpsey "Const HEADER As String = "工作表保护密码破解"Const VERSION As String = DBLSPACE & "版本Version 1.1.1"Const REPBACK As String = DBLSPACE & ""Const ZHENGLI As String = DBLSPACE & " hfhzi3—戊冥整理"Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ & DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！"Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!"Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _"如果该文件工作表有不同密码,将搜索下一组密码并修改清除"Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _"如果该文件工作表有不同密码,将搜索下一组密码并解除"Const MSGONLYONE As String = "确保为唯一的?"Dim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Dim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenElseOn Error Resume NextDo 'dummy do loopFor 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 T o 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 ThenPWord1 = 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, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For 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 ThenPWord1 = 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 sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADEREnd Sub4．点保存，然后关闭“BOOK1”5．点运行，就OK了。

Excel 解锁代码

第一步：1、打开该文件，先解除默认的“宏禁用”状态。

方法是：点击工具栏下的“选项”状态按钮，打开“MicrosoftOffice安全选项”窗口，选择其中的“启用此内容”，“确定”退出。

”（或：安全性→宏安全性→非常高，然后点确定、确定）2、再次点击“宏”→“录制宏”，出现“录制新宏”窗口，在“宏名”定义一个名称为：PasswordBreaker，点击“确定”退出。

第二步：1、再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“编辑”，打开“MicrosoftVisualBasic”编辑器，清空编辑器里所有的内容，把如下代码复制到编辑器右边的窗口栏内：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub第三步：1、再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“运行”，密码就现形了，同时你的文档也就消除了保护。

excelxx保护工作表忘记密码办

excelxx保护工作表忘记密码办Excel表格中忘了撤销工作表保护密码怎么办？用宏代码破解密码：以officexx为例说明，（xx也是一样的，只是菜单命令的位置不同）第一步：打开该文件，先解除默认的“宏禁用”状态，方法是点击工具栏下的“选项”状态按钮，打开“Microsoft Office安全选项”窗口，选择其中的“启用此内容”，“确定”退出；再切换到“视图”选项卡，点击“宏”→“录制宏”，出现“录制新宏”窗口，在“宏名”定义一个名称为：PassWordBreaker，点击“确定”退出；第二步：再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“”，打开“Microsoft Visual Basic”器，用如下内容替换右侧窗口中的所有代码：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For 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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub第三步：再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“执行”，密码就现形了。

解除excel中的宏密码

解除excel中的宏密码
解除excel中的宏密码
第一步：将文件另存为2003版本的格式（.xls）
第二步：用普通的文本编辑器打开2003版本的文件，文件类型为所有文件，我用的是Notepad++
第三步：然后在文件里查找“DPB”修改为“DPx”，注意大小写
第四步：保存后重新打开文件，会遇到一些错误，忽略
第五步：打开Visual Basic的时候也会遇到一些错误，继续忽略
第六步：从VBA编辑器的“工具”菜单，选择VBAProject属性（E）,“保护”面板，输入新的密码，保存并关闭excel
第七步：重新启动excel打开该文件，进入开发工具Visual Basic，输入刚才设置的密码，就可以看到加密的代码了
第八步：回到VBA编辑器的“保护”面板，去掉密码和锁定，保存文件，加密去除成功。

Excel使用VBA破解工作表／工作簿密码

DBLSPACE & _"The password found was: " & DBLSPACE & "$$" & DBLSPACE &
_"Note it down for potential future use in other workbooks by " & _"t
he same person who set this password." & DBLSPACE & _"Now to check and
re / windows " & _"protected with the password that was just found." &
_ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As Wor
ksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m
s " & _"put there for a reason. Don't stuff up crucial formulas " & _"
or data." & DBLSPACE & "Access and use of some data " & _"may be an of
fense. If in doubt, don't."Const MSGNOPWORDS1 As String="There were no

用宏代码破解工作表保护密码

用宏代码破解密码：以office2007为例说明，（2003也是一样的，只是菜单命令的位置不同）第一步：打开该文件，先解除默认的“宏禁用”状态，方法是点击工具栏下的“选项”状态按钮，打开“Microsoft Office安全选项”窗口，选择其中的“启用此内容”，“确定”退出；再切换到“视图”选项卡，点击“宏”→“录制宏”，出现“录制新宏”窗口，在“宏名”定义一个名称为：PassWordBreaker，点击“确定”退出；第二步：再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“编辑”，打开“Microsoft Visual Basic”编辑器，用如下内容替换右侧窗口中的所有代码：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub第三步：再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“执行”，密码就现形了。

excel密码解锁

1．点击“宏”→“宏”，出现窗口，在“宏名”定义一个名称为：PasswordBreaker，点击“创建”，然后关闭弹出的窗口，退出;2．再点击“宏”→“宏”，选择“宏名”下的“PasswordBreaker”并点击“编辑”，打开“Microsoft Visual Basic”编辑器，用如下内容替换右侧窗口中的所有代码：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub3．再点击“宏”→“宏”，选择“宏名”下的“PasswordBreaker”并点击“执行”，密码就现形了，有个弹出对话窗口的，告诉你一个可以用的密码。

Excel用VBA去除工作表保护密码

Excel用VBA去除工作表保护密码Excel 的工作表保护是非常脆弱的。

下面的VBA代码虽然不能找出工作表保护密码，但可以取消工作表保护，如果自己的工作表保护密码忘记了，可以用这个方法：1.按Alt+F11，打开VBA编辑器。

2.在“工程”窗口中选择要取消保护的工作表名称，单击菜单“插入→模块”。

3.在右侧的代码窗口中输入下列代码：Sub Remove_WorkSheet_Password()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextIf ActiveSheet.ProtectContents = False ThenMsgBox "该工作表没有保护密码！"Exit SubEnd IfFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "已经解除了工作表保护！"Exit SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub4.关闭VBA编辑器，回到工作表中，按Alt+F8，打开“宏”对话框，选择“Remove_WorkSheet_Password”，并单击“执行”按钮。

如何破解EXCEL表格的密码保护完整版

如何破解E X C E L表格的密码保护集团标准化办公室：[VV986T-J682P28-JP266L8-68PNN]如何破解EXCEL表格的密码保护我们常常会在EXCEL输入密码以保护部分表格不被他人修改，但往往会忘记密码，现提供一解决方法，供大家参考！1.按Alt+F11，打开VBA编辑器。

2.在“工程”窗口中选择要取消保护的工作表名称，单击菜单“插入→模块”。

3.在右侧的代码窗口中输入下列代码：SubRemove_WorkSheet_Password()DimiAsInteger,jAsInteger,kAsIntegerDimlAsInteger,mAsInt eger,nAsIntegerDimi1AsInteger,i2AsInteger,i3AsIntegerDimi4AsInteger,i5AsInteger,i6AsI ntegerOnErrorResumeNextIfActiveSheet.ProtectContents=FalseThenMsgBox"该工作表没有保护密码！"ExitSubEndIfFori=65To66:Forj=65To66:Fork=65To66Forl=65To66:Form=65To66:Fori1=65To66F ori2=65To66:Fori3=65To66:Fori4=65To66Fori5=65To66:Fori6=65To66:Forn=32To126ActiveShee t.UnprotectChr(i)&Chr(j)&Chr(k)&_Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&Chr(i3)&_Chr(i4)&Chr(i 5)&Chr(i6)&Chr(n)IfActiveSheet.ProtectContents=FalseThenMsgBox"已经解除了工作表保护！"ExitSubEndIfNext:Next:Next:Next:Next:NextNext:Next:Next:Next:Next:NextEndSub4.关闭VBA编辑器，回到工作表中，按Alt+F8，打开“宏”对话框，选择“Remove_WorkSheet_Password”，并单击“执行”按钮。

excel的宏破解方法

用excel的宏破解法1，打开需要解除保护的EXCEL工作表；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'' NormanHarker 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 passwordsConst DBLSPACE As String = vbNewLine&vbNewLineConst 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 & VERSIONConst MSGNOPWORDS2 As String = "There was no protection to "& _"workbook structure or windows." & DBLSPACE & _"Proceeding to unprotect sheets."& AUTHORS & VERSIONConst 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 & VERSIONConst MSGONLYONE As String = "Only structure / windows "& _ "protected with the password that was just found." & _ ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTagAs Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructureOr .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTagOr w1.ProtectContentsNext w1If Not ShTagAnd Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenMsgBox MSGNOPWORDS2, vbInformation, HEADERElseOn Error Resume NextDo 'dummy do loopFor 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 ThenPWord1 = Chr(i) &Chr(j) &Chr(k) &Chr(l) & _Chr(m) &Chr(i1) &Chr(i2) &Chr(i3) & _Chr(i4) &Chr(i5) &Chr(i6) &Chr(n) MsgBoxApplication.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTagAnd Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTagOr w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For 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 .ProtectContentsThenPWord1 = Chr(i) &Chr(j) &Chr(k) &Chr(l) & _Chr(m) &Chr(i1) &Chr(i2) &Chr(i3) & _Chr(i4) &Chr(i5) &Chr(i6) &Chr(n)MsgBoxApplication.Substitute(MSGPWORDFOUND2, _"$$", PWord1), vbInformation, HEADER'leverage finding Pword by trying on other sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub。

用VBA宏代码破解EXCEL保护

用VBA宏代码破解EXCEL保护第一步：打开该文件，先解除默认的“宏禁用”状态。

方法是：把工具栏下的【宏】→【安全性】中的【安全级】设置为中或者为低即可。

再切换到工具栏下的【宏】→【录制新宏】，出现“录制新宏”窗口，在“宏名”定义一个名称为：PassWordBreaker，点击“确定”退出；第二步：再点击工具栏下的【宏】→【宏（M）】，选择“宏名”下的“PasswordBreaker”并点击“编辑”，打开“Microsoft Visual Basic”编辑器，用如下内容替换右侧窗口中的所有代码：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub第三步：再点击工具栏下的【宏】→【宏（M）】，选择“宏名”下的“PasswordBreaker”并点击“执行”，密码就现形了。

如何破解excel宏密码的方法

如何破解excel宏密码的方法在Excel中经常需要设置密码保护重要的数据，但时间过后密码就会容易忘记，这个时候就需要破解密码了，接下来是店铺为大家带来的如何破解excel宏密码的方法，希望对你有用。

如何破解excel宏密码的方法：破解宏密码步骤1：打开需要破解的文件，并点开需要输入密码的界面，如图破解宏密码步骤2：使用EXCEL.EXE重新打开一个工作簿。

破解宏密码步骤3：打开新工作簿的VBA代码区域，并插入一个模块。

破解宏密码步骤4：插入如下代码Sub test()Dim st, nd, th3, th4, th5, th6, th7, th8 As VariantDim ii, jj, kk, ll, mm, nn, oo, pp, qq As IntegerDim PADN, PD, IJ, JK, PADNO, speedspeed = 0.005st = 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 100If Sheet1.Cells(IJ, 1) = "" Then Sheet1.Cells(IJ, 1) = NowExit ForElseEnd IfNext IJPauseTime = 2Start = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSelect Case (PADNO)Case 1For ii = 0 To 61PD = st(ii)SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"Next iiCase 2For ii = 0 To 61For jj = 0 To 61PD = st(ii) & nd(jj)SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"Next jjNext iiCase 3For ii = 0 To 61For jj = 0 To 61For kk = 0 To 61PD = st(ii) & nd(jj) & th3(kk) SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"Next kkNext jjNext iiCase 4For ii = 0 To 61For jj = 0 To 61For kk = 0 To 61For ll = 0 To 61PD = st(ii) & nd(jj) & th3(kk) & th4(ll) SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"Next llNext kkNext jjNext iiCase 5For ii = 0 To 61For jj = 0 To 61For kk = 0 To 61For ll = 0 To 61For mm = 0 To 61PD = st(ii) & nd(jj) & th3(kk) & th4(ll) & th5(mm) SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTime DoEventsLoopFinish = TimerSendKeys "{enter}"Next mmNext llNext kkNext jjNext iiCase 6For ii = 0 To 61For jj = 0 To 61For kk = 0 To 61For ll = 0 To 61For mm = 0 To 61For nn = 0 To 61PD = st(ii) & nd(jj) & th3(kk) & th4(ll) & th5(mm) & th6(nn) SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTimeDoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTimeDoEventsLoopFinish = TimerSendKeys "{enter}"Next nnNext mmNext llNext kkNext jjNext iiCase 7For ii = 0 To 61For jj = 0 To 61For kk = 0 To 61For ll = 0 To 61For mm = 0 To 61For nn = 0 To 61For oo = 0 To 61PD = st(ii) & nd(jj) & th3(kk) & th4(ll) & th5(mm) & th6(nn) & th7(oo)SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTimeDoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTimeDoEventsLoopFinish = TimerSendKeys "{enter}"Next ooNext nnNext mmNext llNext kkNext jjNext iiCase 8For ii = 0 To 61For jj = 0 To 61For kk = 0 To 61For ll = 0 To 61For mm = 0 To 61For nn = 0 To 61For oo = 0 To 61For pp = 0 To 61PD = st(ii) & nd(jj) & th3(kk) & th4(ll) & th5(mm) & th6(nn) & th7(oo) & th8(pp)SendKeys PDPauseTime = speedStart = TimerDo While Timer < Start + PauseTimeDoEventsLoopFinish = TimerSendKeys "{enter}"PauseTime = speedStart = TimerDo While Timer < Start + PauseTimeDoEventsLoopFinish = TimerSendKeys "{enter}"Next ppNext ooNext nnNext mmNext llNext kkNext jjNext iiEnd SelectFor JK = 1 To 100If Sheet1.Cells(JK, 2) = "" ThenSheet1.Cells(JK, 2) = NowExit ForElseEnd IfNext JKEnd Sub破解宏密码步骤5：按F5执行代码，输入密码长度。

excel文件忘记密码后的解密方法

excel文件忘记密码后的解密方法excel文件密码的设置有2种，一种是写保护，另外一种是打开保护。

对应不同的保护措施，应该用不同的解密方法。

一：这是写保护的破解：方法:1\打开文件2\工具---宏----录制新宏---输入名字如:aa3\停止录制(这样得到一个空宏)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 passwordsConst DBLSPACE As String = vbNewLine & vbNewLineConst 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 & VERSIONConst MSGNOPWORDS2 As String = "There was no protection to " & _ "workbook structure or windows." & DBLSPACE & _"Proceeding to unprotect sheets." & AUTHORS & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst MSGONLYONE As String = "Only structure / windows " & _"protected with the password that was just found." & _ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShT ag As Boolean, WinT ag As Boolean Application.ScreenUpdating = False With ActiveWorkbookWinT ag = .ProtectStructure Or .ProtectWindowsEnd WithShT ag = FalseFor Each w1 In WorksheetsShT ag = ShT ag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADER Exit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenMsgBox MSGNOPWORDS2, vbInformation, HEADER ElseOn Error Resume NextDo 'dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For 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 ThenPWord1 = 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, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShT ag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not.ShT ag = ShT ag Or w1.ProtectContentsNext w1If ShT ag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For 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 ThenPWord1 = 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 sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub6. 然后执行便可获得密码附件：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 T o 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 T o 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 T o 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub今天解决的大问题！！解释一下：当Excel工作表采用密码保护时，就会生成一个16位(双字节) 长hash值。

破解工作表密码和共享EXCEL表锁定破解

今天下载了一个Excel2003文档，对里面的一些函数甚是感兴趣，但郁闷的是作者对文档进行了加密，有函数的地方全部设成只读属性了！在Excel的菜单中点击”撤销工作表”,提示输入密码!原来如此,上网搜了一个VBA宏破解的方法,一下就成功了啊!牛人还真的多啊!不得不佩服啊,下面就说一下这个方法吧1．点击“宏”→“宏”，出现窗口，在“宏名”定义一个名称为：PasswordBreaker，点击“创建”，然后关闭弹出的窗口，退出;2．再点击“宏”→“宏”，选择“宏名”下的“PasswordBreaker”并点击“编辑”，打开“Microsoft Visual Basic”编辑器，用如下内容替换右侧窗口中的所有代码：Sub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.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 ThenMsgBox "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)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = 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 SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub3．再点击“宏”→“宏”，选择“宏名”下的“PasswordBreaker”并点击“执行”，密码就现形了，有个弹出对话窗口的，告诉你一个可以用的密码。

破解excel密码宏程序代码

1.将你要破解的Excel文件关闭，切记一定要关闭呀！然后新建一个Excel文件2.打开新建的这个Excel，按下alt+F11，打开vb界面，新建一个模块，如图所示3.将代码复制到这个模块中，代码如下：Private Sub VBAPassword() '你要解保护的Excel文件路径Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解")If Dir(Filename) = "" ThenMsgBox "没找到相关文件,清重新设置。

"Exit SubElseFileCopy Filename, Filename & ".bak" '备份文件。

End IfDim GetData As String * 5Open Filename For Binary As #1Dim CMGs As LongDim DPBo As LongFor i = 1 To LOF(1)Get #1, i, GetDataIf GetData = "CMG=""" Then CMGs = iIf GetData = "[Host" Then DPBo = i - 2: Exit ForNextIf CMGs = 0 ThenMsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"Exit SubEnd IfDim St As String * 2Dim s20 As String * 1'取得一个0D0A十六进制字串Get #1, CMGs - 2, St'取得一个20十六制字串Get #1, DPBo + 16, s20'替换加密部份机码For i = CMGs To DPBo Step 2Put #1, i, StNext'加入不配对符号If (DPBo - CMGs) Mod 2 <> 0 ThenPut #1, DPBo + 1, s20End IfMsgBox "文件解密成功......", 32, "提示"Close #1End Sub4.然后点击运行按钮，如图所示，绿色的小三角就是5.你会看到，打开了一个文件夹，找到我们要破解的这个文件，然后点击打开6.稍等几分钟你就会看到破解成功的提示了1\打开文件2\工具---宏----录制新宏---输入名字如:aa3\停止录制(这样得到一个空宏)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 passwordsConst DBLSPACE As String = vbNewLine & vbNewLineConst 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 & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenMsgBox MSGNOPWORDS2, vbInformation, HEADERElseOn Error Resume NextDo 'dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For 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 ThenPWord1 = 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, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not.ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For 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 ThenPWord1 = 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 sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub。

Excel密码忘记：破解Excel密码

.public.excel.programming newsgroup." Const ALLCLEAR As String=DBLSPA
CE & "The workbook should " & _ "now be free of all password protecti
on, so make sure you:" & _ DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "an
r Resume Next For Each w1 In Worksheets 'Attempt clearance with PWor
d1 w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag=False For Ea
ch w1 In Worksheets 'Checks for all clear ShTag triggered to 1 if not
who " & _ "set this password." & DBLSPACE & "Now to check and clear "
&_ "other passwords." & AUTHORS & VERSION Const MSGonLYONE As Stri
ng="only structure / windows " & _ "protected with the password that

破解EXCEL表格保护密码宏代码

Option ExplicitPublic 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 passwordsConst DBLSPACE As String = vbNewLine & vbNewLineConst 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 & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenMsgBox MSGNOPWORDS2, vbInformation, HEADERElseOn Error Resume NextDo 'dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126With ActiveWorkbook.UnprotectChr (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 ThenPWord1 = 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, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For 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 ThenPWord1 = 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 sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER End Sub。