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