excelvbaproject保护密码破解查看见过较详细的操作

合集下载

如何利用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“工程不可查看”及VBA工程密码破解。

一、Excel“工程不可查瞧”两种实现方法及破解关于Excel宏编程中,要用到一些技巧,如破解Excel宏加密。

今天我对一个Excel宏编程中进行日期限制进行了破解。

方法一(共用级锁定)1、先对excel档进行一般的vbaproject”工程密码保护。

2、打开要保护的档,选择∶工具--->保护--->保护并共用活页簿--->以追踪修订方式共用-->输入密码-->保存档。

完成後,当您打开“vbaproject”工程属性时,就将会提示∶“工程不可瞧！”方法二(推荐,破坏型锁定)用16进制编辑工具,如winhex、ultraedit-32(可到此下载)等,再历害点的人完全可以用debug命令来做、、、、、、用以上软体打开excel档,查找定位以下地方∶id="{00000000-0000-0000-00000}" 注∶实际显示不会全部为0 此时,您只要将其中的位元组随便修改一下即可。

保存再打开,就会发现大功告成！当然,在修改前最好做好您的文档备份。

至於恢复只要将改动过的地方还原即可(只要您记住了呵呵)。

破解方面,有网友说将CMG=,DPB=与GC=后的"="替换为"、"也可以的,我已测试过的确可以,这样更省事点。

用16进制编辑工具,如winhex、ultraedit-32打开X、xls文件,查找ID=、、、、、、, 或到文件尾查瞧,找到即可。

改其中的任意一位,存盘就可达到目的,注意:留有备份文件二、EXCEL宏保护密码破解-VBA工程密码破解在办公中我们常瞧到许多用宏(VBA)编写的EXCEL表格,而这些表格就如同一个数据库,我们可以选取或查询很多的数据,一般的这些数据就是存放在一个隐藏的工作表中的,那么要如何显示这个隐藏的工作表呢?我们可以打开宏编辑器(ALT+F11),再安CTRL+R打开专案,这时弹出窗会有所有的这个EXCEL的工用表,这时您就可以瞧瞧那些就是被隐藏的了,很多时候打开就是需要密码的,用以下方法解密后,再将解密后文件打开,依同样方法在工作表标签中右键>>检视程式码>>复制以下代码>>按F8执行Private Sub CommandButton1_Click()Worksheets("这里为您要显示的工作表名称")、Visible = TrueEnd Sub关于破解EXCEL VBA工程密码的方法,以下代码非常有效,首先建一新EXCEL文件,在工作表标签处右点>>检视程式码>>复制以下代码>>按F8执行在弹出窗中选您要您破解工程密码的EXCEL文件>>再按F5执行即可、Private Sub VBAPassword()'您要解保护的Excel文件路径= Application、GetOpen("Excel文件(*、xls & *、xla & *、xlt),*、xls;*、xla;*、xlt", , "VBA破解")If Dir() = "" ThenMsgBox "没找到相关文件,清重新设置。

ex-vba迄今为止最简单的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
在此再次感谢大神们的分享！同时，一门技术是好是坏，
全凭个人掌握，用于益处是为好……
欢迎您的下载，
资料仅供参考！
致力为企业和个人提供合同协议，策划案计划书，学习资料等等
打造全网一站式需求。

Excel“工程不可查看”及VBA工程密码破解。

一、Excel“工程不可查瞧”两种实现方法及破解关于Excel宏编程中,要用到一些技巧,如破解Excel宏加密。

今天我对一个Excel宏编程中进行日期限制进行了破解。

方法一(共用级锁定)1、先对excel档进行一般的vbaproject”工程密码保护。

2、打开要保护的档,选择∶工具--->保护--->保护并共用活页簿--->以追踪修订方式共用-->输入密码-->保存档。

保存再打开,就会发现大功告成！当然,在修改前最好做好您的文档备份。

至於恢复只要将改动过的地方还原即可(只要您记住了呵呵)。

破解方面,有网友说将CMG=,DPB=与GC=后的"="替换为"、"也可以的,我已测试过的确可以,这样更省事点。

用16进制编辑工具,如winhex、ultraedit-32打开X、xls文件,查找ID=、、、、、、, 或到文件尾查瞧,找到即可。

ExcelVBA破解工作表工作簿保护密码

ExcelVBA破解工作表工作簿保护密码Excel VBA破解工作表/工作簿保护密码平时在用Excel编辑文件时，如果不希望别人修改文件的内容，我们一般会为工作表或工作簿添加上密码，起到保护作用。

而当我们从网上下载了一个Excel文档，如果里面带有工作表/工作簿密码保护，我们又急需修改这个文件，这时我们又该怎么办呢？今天，我们就来讲一下Excel工作表/工作簿密码的攻与防，正所谓没有最硬的盾，也没有最快的矛，矛与盾的关系就看我们怎么处理了。

好了，闲话少说，打板就唱。

怎么样设置工作表/工作簿密码？制作好Excel表后，点击工具菜单下的保护->保护工作表/保护工作簿，在弹出的对话框中设置上密码即可。

密码尽量设置的复杂点，防止暴力破解。

到此，工作表/工作簿密码就设置好了，下面我们就开始讲怎么破解这个密码。

怎么样破解这个密码？注意：在破解之前最好先备份，免得发生意外！破解密码，一般人都会想到用软件来破解，而我们今天是用VBA 来进行破解。

首先打开VBA编辑器。

1、点击工具->宏->Visual Basic编辑器，打开VBA的编辑器。

２、在Visual Basic编辑器中，点击插入->模块，插入一个新的模块，我们的代码就是写到这个新的模块中的。

5、程序开始运行后，会弹出两次对话框，直接确定即可。

6、大约2分钟左右后，即弹出完成对话框，下图中画红线的地方即是找到的密码（注意：最后的那个也是密码中的一部分），单击确定后，文件中的密码即被清除。

７、如果只想找到密码而不想清除它，只要不保存文件，重新打开后在工具->保护->撤消工作表/工作簿保护，输入刚才找到的密码即可。

8、需要说明的一点是，找到的这个密码并不是真正设置时输入的密码，但确可以使用。

比如刚才找到的这个密码，而我设置时用的是123为密码的，不知这种情况是Excel的漏洞还是有意为之的，总之都可以撤消对工作表的保护。

总结看到这里，我们要问了，那怎么样的密码才算安全呀？其实安全是需要配合使用的，我们刚才的代码只是破解工作表/工作簿密码的，而我们可以用更多其它方面的保护来防止我们的文件不被破解，比如权限的设置（文件->权限）等。

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”，并单击“执行”按钮。

破解VBAProject保护口令

破解VBAProject保護口令1﹑使用UltraEdit32或其它二進制編輯工具2﹑你理解二進制﹑十進制﹑十六進制的概念3﹑Excel 中的_VBA_Project_CUR storage(我們可以理解為一個目錄) 下的Project Stream(可以理解為一個文件)是一個純文本文件。

如下例所示意﹐是一個包含了一個工作表(Worksheet)﹑一個模塊(Moudle)的Project stream。

其表達式為:命令符=串...[小節]命令符=串每行間用&h0d﹑&h0a (回車﹑換行)分隔。

所以﹐這就為我們簡單地破解提供了條件。

'********************************************'*** 帶有VBA 的Excel﹐沒有口令保護***'********************************************ID="{87EEB809-E9F0-11D6-95A2-008888998168}"Document=ThisWorkbook/&H00000000Document=Sheet1/&H00000000Module=模塊1Name="VBAProject"HelpContextID="0"VersionCompatible32="393222000"CMG="DBD91940F044F044F044F044"DPB="B6B474AD94536E546E546E"GC="91935354545454AB"[Host Extender Info]&H00000001={3832D640-CF90-11CF-8E43-00A0C911005A};VBE;&H00000000 [Workspace]ThisWorkbook=0, 0, 0, 0, CSheet1=0, 0, 0, 0, C模塊1=22, 22, 155, 343, Z下例是同一個文件﹐增加了口令保護的project stream。

关于Excel使用VBA 宏的密码破解方法和思路

对于那种试用的含有VBA宏的Excel 是最好破的。

这样的Excel 文件一般加载了dll文件，一打开就提示输入密码，然后还提示你只能使用多少次。

有次数限制当然不爽了，呵呵，所以必须破解。

首先用Advanced Office Password Recovery 打开文件，马上就会破解出通用密码，然后点击删除VBA密码，然后拷贝工作薄密码。

打开Excel 文件，撤销工作薄保护，粘贴你刚才复制的密码。

继续看每个表有保护没，有的话全部撤销。

每个工作表的密码在刚才的软件界面上都有。

然后打开VBA编辑器，提示输入密码，不管它，因为密码已经删除了，所以点击确定就可以进去了。

展开工程，删除里面用户保护的VBA代码，保存，关闭。

再打开Excel 时你就会发现已经不会提示输入任何密码了，破解完成。

对于不提供试用，只提供输入密码才能访问，而且一打开就全屏的提示输入密码。

这样的Excel 破解起来稍微要麻烦一点，不过还是能破。

具体方法有空了再写。

就按照刚刚破解的一个VBA加密的Excel 写一下破解思路，仅供参考。

打开Excel 只看到一个表，然后马上出现全屏运行的密码输入窗口。

看来该加密方式是利用的这个表写的VBA代码。

只有输入正确密码才能登陆，如果点取消，则Excel 就马上关闭了。

在全屏的界面按下ALT+F 调出菜单栏，一直按右键，到“工具”菜单，选择“保护”，继续选择“撤销工作薄保护”，然后输入上面用软件破解出来的工作薄保护密码，然后确定。

如果没有出现密码错误对话框，就说明密码正确了。

然后按CTRL+S保存，等保存完毕，再回到那个登陆窗口，点击取消。

此时你就会发现Excel 没有关闭，而是绕过用户密码登陆直接进入了，里面就是你想要看到的Excel 表。

此时不要关闭Excel ，不然待会又要求输入登陆密码。

进入“工具”-“宏”-“Visual Basic 编辑器”，双击VBAProjiect，会提示输入密码，因为在前面已经用软件删除了VBA密码，所以直接点确定就可以进入。

EXCEL工作表密码保护的解除方法

Excel工作表密码保护的解除方法Excel弹出“您试图更改的单元格或图表受保护,因而是只读的;若要修改受保护单元格或图表,请先使用‘撤消工作表保护’命令在‘审阅’选项卡的‘更改’组中来取消保护;可能会提示您输入密码;出现这种情况,应该怎么解决呢经过研究,找到了两种破解Excel工作表保护码的方法;一、VBA宏代码破解法：第一步：打开该文件第二步：按Alt F11,进入VBA编辑界面；第三步：插入一个Module；第四步：在右边Module的空白编辑区域,复制粘贴下面的所有内容；第五步：按F5,运行该VBA命令；密码就现形了;Sub PasswordDim 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 Chri & Chrj & Chrk & _Chrl & Chrm & Chri1 & Chri2 & Chri3 & _Chri4 & Chri5 & Chri6 & ChrnIf ActiveSheet.ProtectContents = False ThenMsgBox "One usable password is " & Chri & Chrj & _Chrk & Chrl & Chrm & Chri1 & Chri2 & _Chri3 & Chri4 & Chri5 & Chri6 & ChrnActiveWorkbook.Sheets1.SelectRange"a1".FormulaR1C1 = Chri & Chrj & _Chrk & Chrl & Chrm & Chri1 & Chri2 & _Chri3 & Chri4 & Chri5 & Chri6 & ChrnExit SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub第六步：切换“审阅”选项卡,点击“撤消工作表保护”,然后输入密码即可解除锁定;二、软件破解法有许多专门为破解Excel各种密码而制作的软件,Excel Key与AdvancedOffice Password Recovery就是其中的佼佼者;它们的使用方法简单且破解速度极快;1. Excel Key下载下载地址：http://.mydown/soft/183/183131.html安装完后运行软件,点击工具栏“Recovery”按钮,找到要破解的文件,软件马上就可以解出密码了图5;2. Advanced Office Password Recovery下载下载地址：http://.mydown/soft/utilitie/security/268/410768.shtml 安装完后运行软件,点击工具栏“Open File”按钮,打开要破解的Excel文件,马上就可以看到解出的密码了图6;可以看出,用以上方法读出的密码完全不同,但它们确实均可以解除该工作表的密码保护,这实在是个有趣的问题;在网上查找了许久,终于找到比较圆满的解释答案：当Excel工作表采用密码保护时,就会生成一个16位双字节长hash值;当输入密码进行验证时,真正进行比较的就是这个hash值;事实上,有很多不同的密码都可以生成同样的hash值;大家可以试试：当你用“test”不含双引号作为Excel工作表保护密码,你同样可以用“zzyw”同样不含双引号这个密码进行解锁;怎么样,神奇吧。

VBA加密解密方法

As Long, ByVal pTemplateName As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
Dim HookBytes(0 To 5) As Byte Dim OriginBytes(0 To 5) As Byte Dim pFunc As Long Dim Flag As Boolean Private Function GetPtr(ByVal Value As Long) As Long GetPtr = Value End Function
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)
Hook End If End Function Sub Crack() If Hook Then MsgBox "破解成功" End Sub
第二种：
Option Explicit Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Long,
Source As Long, ByVal Length As Long) Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, ByVal dwSize As
Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long Private Declare Function GetModuleHandleA Lib leName As String) As

破解Excel文件密码保护的方法（VBA宏代码破解法）

破解Excel文件密码保护的方法（VBA宏代码破解法）破解Excel文件密码保护的方法(VBA宏代码破解法)第一步：打开该文件，先解除默认的“宏禁用”状态，方法是点击栏下的“选项”状态按钮，打开“Microsoft Office安全选项”窗口，选择其中的“启用此内容”，“确定”退出；再切换到“视图”选项卡，点击“宏”→“录制宏”，出现“录制新宏”窗口，在“宏名”定义一个名称为：PassBreaker(图3)，点击“确定”退出；第二步：再点击“宏”→“查看宏”，选择“宏名”下的“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表格保护密码

破解excel表格保护密码1.点击“工具---宏—录制新宏”2.从出现的菜单中点击“停止”按钮。

3.再点“工具---宏---宏（visual basic 编辑器）”4.点“VBAProject---双击模块—模块1”把右边代码框内的内容全部删除，粘贴以下内容（后面的英文代码），点击工具---宏---执行。

5.出现的提示，点击两次确认，即破解。

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 & 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 MSGONL YONE 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 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 MSGONL YONE, 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 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 .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工作表保护密码忘记之解决办法

工作表保护密码破解（图解）1、新建一个EXCEL文件“BOOK1”，在工具栏空白位置，任意右击，选择Visual Basic项，弹出Visual Basic工具栏：2、在Visual Basic工具栏中，点击“录制”按钮，弹出“录制新宏”对话框，选择“个人宏工作簿”：3、选择“个人宏工作簿”后按确定，弹出如下“暂停”按钮，点击停止：4、在Visual Basic工具栏中，点击“编辑”按钮：5、点击“编辑”按钮后，弹出如下图的编辑界面：找到“VBAProject（PERSONAL.XLS）－模块－模块1（也可能是模块N-其他数字）”双击模块1－将右边代码容清空6、复制“工作保护密码破解”代码到右边框中，点保存，然后关闭“BOOK1”7、运行需要解密的“EXCEL文件”，在Visual Basic工具栏中，点击“运行”按钮8、点击“运行”按钮后，弹出“宏”对话框，点击运行“PERSONAL.XLS!工作保护密码破解”这个宏9、运行“PERSONAL.XLS!工作保护密码破解”这个宏后，如下图示意就可以解除工作表的密码保护了（这个图，如果工作表中有多组不同密码，每解开一组，就会提示一次，也就说可能会出现几次）工作表保护密码破解(代码）=========请复制以下容=============Public Sub 工作表保护密码破解() Const DBLSPACE As String = vbNewLine & vbNewLine Const 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 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 IntegerDim 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 ElseOn 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 IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADER Exit Sub End If On Error Resume NextFor 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 IfEnd With Next w1 End If MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADEREnd Sub =========================================================。

如何破解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执行代码，输入密码长度。

使用与破解ExcelVBA密码

使⽤与破解ExcelVBA密码
最近在给朋友做⼀个⾃动计算的VAB，但奈何基础知识不怎么扎实，做着做着最后还是向度娘求助了
找了⼏个不错的Excel就进⾏研究了
这⾥记述⼀些知识，为了⽅便以后能够⽤到，也⽅便⼀些有需要的朋友。

现在Excel更新很快，都到2016版本了（⽬前我使⽤的版本），Excel功能也很强⼤，简单的数据分析什么的完全能够⽤上，不是统计专业的基本Excel完全够⽤（飘过、、、、、）
1.将需要破解的Excel另存为
2.使⽤⽂本编辑器（NotePad++）打开这个⽂件 ————勾选始终
3.查找—（Ctrl+F）修改“DPB”————改成DPx
4.重新打开exce⽂件
弹出错误———————不管它，除⾮......
进⼊开发者⼯具——Visual Basic （如果你连 Visual Basic 都不知道那么希望你点击右上⾓红X）
重新设置⼀个你的密码，然后重新打开Excel——在这之前你可能会被弹窗搞崩溃，但是慢慢的，你会成功的啦。

excel2013利用VBA编程解锁密码的教程

excel2013利用VBA编程解锁密码的教程在Excel中经常需要用到密码保护进行对重要数据保护，而因为时间过得久了，久而久之就忘记密码了，这个时候就需要我们动用一些技术利用VBA编程进行解锁密码，具体该如何操作呢，下面是店铺带来的关于excel2013利用VBA编程解锁密码的教程，希望阅读过后对你有所启发!excel2013利用VBA编程解锁密码的教程：利用VBA编程解锁步骤1：将你要破解的Excel文件关闭，切记一定要关闭呀!然后新建一个Excel文件利用VBA编程解锁步骤2：打开新建的这个Excel，按下alt+F11，打开vb界面，新建一个模块，如图所示利用VBA编程解锁步骤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 Sub利用VBA编程解锁步骤4：然后点击运行按钮，如图所示，绿色的小三角就是利用VBA编程解锁步骤5：你会看到，打开了一个文件夹，找到我们要破解的这个文件，然后点击打开利用VBA编程解锁步骤6：稍等几分钟你就会看到破解成功的提示了利用VBA编程解锁步骤7：再次打开你要破解的这个文件，你会看到这里已经可以查看代码了哈哈。

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

EXCEL VBA Project密码破解过程可能有些繁琐，EXCEL工作表保护密码破解方法: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' Modified 2003-Apr-04 by JEM: All msgs to constants, and' eliminate one Exit Sub (Version' 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 2003-Apr-04"Const REPBACK As String = DBLSPACE & "Please report failure " & _"to the 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 & 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 Integer Dim PWord1 As StringDim ShTag As Boolean, WinTag As Boolean= FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag OrNext 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 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 (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 PWord1PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag OrNext 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 .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 (MSGPWORDFOUND2, _"$$", PWord1), vbInformation, HEADER'leverage finding Pword by trying on other sheetsFor Each w2 In WorksheetsPWord1Next 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如何破解VBAProject属性的保护密码1、打开任一excel文件2、在宏里粘贴下面的代码3、运行下面的代码4、选择需要破解密码的文件5、点击“打开”'移除VBA编码保护Sub MoveProtect()Dim FileName As StringFileName = ("Excel文件（*.xls & *.xla&*.xlsx）,*.xls;*.xla;*.xlsx", , "VBA破解")If FileName = CStr(False) ThenExit SubElseVBAPassword FileName, FalseEnd IfEnd Sub'设置VBA编码保护Sub SetProtect()Dim FileName As StringFileName = ("Excel文件（*.xls & *.xla&*.xlsx）,*.xls;*.xla;*.xlsx", , "VBA破解")If FileName = CStr(False) ThenExit SubElseVBAPassword FileName, TrueEnd IfEnd SubPrivate Function VBAPassword(FileName As String, Optional Protect As Boolean = False)If Dir(FileName) = "" ThenExit FunctionElseFileCopy 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 FunctionEnd IfIf Protect = False ThenDim 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, "提示"ElseDim MMs As String * 5MMs = "DPB="""Put #1, CMGs, MMsMsgBox "对文件特殊加密成功......", 32, "提示"End IfClose #1End Function如果你是要破解EXCEL工作表保护密码，请按“EXCEL工作表保护密码破解”操作，若在录制宏时，要求输入VBAProject密码，请先按后面的“如何破解VBAProject属性的保护密码”破解VBAProject密码，然后再按“EXCEL工作表保护密码破解”操作即可。