今天從網上學到如何破解vba工程密碼以及工作表保護密碼，在這里分享一下。
破解vba工程密碼：（引用自http://jingyan.baidu.com/article/2009576170cc05cb0721b437.html）
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) = "" Then MsgBox "沒找到相關文件,清重新設置。" Exit Sub Else FileCopy Filename, Filename & ".bak" '備份文件。 End If Dim GetData As String * 5 Open Filename For Binary As #1 Dim CMGs As Long Dim DPBo As Long For i = 1 To LOF(1) Get #1, i, GetData If GetData = "CMG=""" Then CMGs = i If GetData = "[Host" Then DPBo = i - 2: Exit For Next If CMGs = 0 Then MsgBox "請先對VBA編碼設置一個保護密碼...", 32, "提示" Exit Sub End If Dim St As String * 2 Dim s20 As String * 1 '取得一個0D0A十六進制字串 Get #1, CMGs - 2, St '取得一個20十六制字串 Get #1, DPBo + 16, s20 '替換加密部份機碼 For i = CMGs To DPBo Step 2 Put #1, i, St Next '加入不配對符號 If (DPBo - CMGs) Mod 2 <> 0 Then Put #1, DPBo + 1, s20 End If MsgBox "文件解密成功......", 32, "提示" Close #1 End Sub
4.然后點擊運行按鈕，如圖所示，綠色的小三角就是：
5.你會看到，打開了一個文件夾，找到我們要破解的這個文件，然后點擊打開：
6.稍等幾分鍾你就會看到破解成功的提示了：
7.再次打開你要破解的這個文件，你會看到這里已經可以查看代碼了：
工作表保護密碼破解（引用自：https://www.fghrsh.net/post/15.html）
1.點擊文件-選項-自定義功能區，找到“開發工具”勾選並確定：
2.進去找到“錄制宏”，把它創建在“個人宏工作簿”：
3.創建好后什么都不用動，直接“停止錄制”，然后點擊“Visual Basic”：
4.在左邊導航欄找到“模塊一”，並雙擊打開：
5.刪掉里面所有內容，把破解代碼替換進去，並保存（切記）：
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 & " FGHRSH 整理" 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 Integer Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean Application.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then MsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End If MsgBox MSGTAKETIME, vbInformation, HEADER If Not WinTag Then Else On Error Resume Next Do 'dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 With ActiveWorkbook .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _ .ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER Exit Do 'Bypass all for...nexts End If End With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If If WinTag And Not ShTag Then MsgBox MSGONLYONE, vbInformation, HEADER Exit Sub End If On Error Resume Next For Each w1 In Worksheets 'Attempt clearance with PWord1 w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag = False For Each w1 In Worksheets 'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then For Each w1 In Worksheets With w1 If .ProtectContents Then On Error Resume Next Do 'Dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65