Excel工作表保护密码忘记之解决办法

1、工 作 表 保 护 密 码 破 解 （图 解）1 、 新 建 一 个 EXCEL 文 件 BOOK1 ”在工具栏空白位置，任意右击，选择 Visual Basic 项弹 出VisualBasic工 具 栏在这里任意右击，Visual BasicWord文档2 、 在 Visual Basic 工具栏中，点击“录制”按钮 弹出“录制新宏”对话框，选择“个人宏工作簿¥i suaJ Sai c xLB安全.一 |相会区I=rL点击求制按2 .弹比录制新宏选框3、 选 择 “个 人弹按停止 按钮后按确 定点击停止辑界面：N-其他数字）”容 清 空点击“编辑”按钮后，弹出如下图的编 找到VBA

2、Project （ PERSONAL.XL9 模块模块1 （也可能是模块 双 击 模 块 1- 将 右 边 代 码6、复制“工作保护密码破解”代码到右边框中，点保存，然后关闭BOOK1”工具栏中，点击 运行”按钮“宏”对话框码破解”这个点击“运行”按钮后，弹出点击运行 PERSONAL.XLS!工作保护密保护密码破解”这个运行 PERSONAL.XLS!工作如下图示意就可以解除工作表的密码工作表保护密码破解区解密需花费一定时间，谓耐心等候!将萌走开始破解！（这个图， 如果工作表中有多组不同密码， 每解开一组，就会提示一次，也就说可能会出现几次）工作袁保犷密码破暮遨工作淳中的工作表密码保护已全部

3、辩除！ ！请记得另俣存注意：不要用在不当地方，要尊重他人的劳动成果，1E者：NuC ocrini c上JE HdGi mpsey版本 V&rsioti 1.1,1-戌W蹩理匚二勉定二口工作表保护密码破解（代码）=请复制以下容=Public Sub 工 作 表 保 护 密 码 破 解 （） Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine &_" 作 者：McCormickJE McGimpsey "Co

4、nst 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 & "该工作簿中的工作表密码保护已全部解除！!” &D

5、BLSPACE &"请 记 得 另 保 存 "& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！" ConstMSGNOPWORDS1AsString="该文件工作表中没有加密”ConstMSGNOPWORDS2AsString="该文件工作表中没有加密 2"Const MSGTAKETIME As String ="解密需花费一定时间，请耐心等候!" & DBLSPACE & "按确 定开始破解!"Const MSGPW

6、ORDFOUND1 DBLSPACEAs String :="密码重新组廿为&:"& DBLSPACE & "$” &"如果该文件工作表有不同密码,将搜索下一一组密码并修改清除"Const MSGPWORDFOUND2 AsDBLSPACE”如果该文件工作表有Const MSGONLYONEAsDimw1AsDimiAsInteger,jDimmAsInteger,nString ="瓷俏与新组合为 &不同密码，将搜索String="确Worksheet,w2AsInteger,kAs

7、AsInteger,i1As:"& DBLSPACE & "$" &下一组密码并 解除" 保 为 唯一的 ？"AsWorksheetInteger,lAsIntegerInteger,i2AsIntegerDim i3As Integer, i4 As Integer,i5 As Integer, i6 As IntegerDimPWord1AsStringDimShTagAsBoolean,WinTagAsBooleanApplication.ScreenUpdating=FalseWithActiveWorkbook

8、WinTag=.ProtectStructureOr.ProtectWindowsEndWithShTag=FalseForEachw1InWorksheetsShTag=ShTagOrw1.ProtectContentsNextw1IfNotShTagAndNotWinTagThenMsgBoxMSGNOPWORDS1,vbInformation,HEADERExitSubEndIfMsgBoxMSGTAKETIME,vbInformation,HEADERIfElseNotWinTagThenOnErrorResumeNextDo'dummydoloopFor i =65 To 6

9、6: For j =65To 66: For k =65 To 66For l =65 To 66: For m =65To 66: For i1 =65 To 66For i2=65 To 66: For i3 =65To 66: For i4 =65 To 66For i5=65 To 66: For i6 =65To 66: For n =32 To 126WithActiveWorkbook.UnprotectChr(i)&Chr(j)&Chr(k)&_Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&_Chr(i3)&

10、amp;Chr(i4)&Chr(i5)&Chr(i6)&Chr(n)If.ProtectStructure=FalseAnd.ProtectWindows=FalseThenPWord1=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,_"$",

11、PWord1),vbInformation,HEADERExitDo'Bypassallfor.nextsEndIfEndWithNext:Next:Next:Next:Next:NextNext:Next:Next:Next:Next:NextLoopUntilTrueOnEnd IfErrorGoTo0IfWinTagAndNotShTagThenMsgBoxExitEndMSGONLYONE,vbInformation,HEADERSubIfOn Error Resume NextForEachw1InWorksheets'AttemptclearancewithPWor

12、d1wl.UnprotectPWord1Nextw1OnErrorGoTo0ShTag=FalseForEachw1InWorksheets'ChecksforallclearShTagtriggeredto1ifnot.ShTag=ShTagOrw1.ProtectContentsNextw1IfShTagThenForEachw1InWorksheetsWithw1If.ProtectContentsThenOnErrorResumeNextDo'DummydoloopFor i =65 To 66: For j =65To 66: For k =65 To 66For l

13、 =65 To 66: For m =65To 66: For i1 =65 To 66For i2 =65 To 66: For i3 =65To 66: For i4 =65 To 66For i5 =65 To 66: For i6 =65To 66: For n =32 To 126.UnprotectChr(i)&Chr(j)&Chr(k)&Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&Chr(i3)&_Chr(i4)&Chr(i5)&Chr(i6)&Chr(n)IfNot.Prot

14、ectContentsThenPWord1=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'leveragefindingPwordbytryingonothersheetsForEachw2InWorksheetsw2.UnprotectPWord1Nextw2ExitDo'Bypass