Excel破解宏代码

1、Excel 破解宏代码Excel 工作表保护密码破解方法:打开文件工具 -宏 录制新宏 -输入名字如 :aa停止录制 （这样得到一个空宏 ）工具-宏宏，选aa点编辑按钮删除窗口中的所有字符 （只有几个 ）,替换为下面的内容 :（复制吧）关闭编辑窗口工具-宏宏,选 AlllnternalPasswords, 运行,确定两次 ,等2分钟,再确定.OK,密码完全被你看见了 !内容如下 :Public Sub Alllnternal Passwords。' Breaks worksheet and workbook structure passwords. Bob McCormick '

2、; 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 (Ver

3、sion 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 JEMcGimpsey"Const HEA

4、DER As String = "AllInternalPasswords UserMessage"Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"Const REPBACK As String = DBLSPACE & "Please report failure " & _"to the gramming newsgroup."Con

5、st ALLCLEAR AsString = DBLSPACE & "The workbook should " & _ "now be free of all password protection, so make sure you:" & _DBLSPACE & "SA VE ITNOW!" & DBLSPACE & "and also" & _DBLSPACE & "BA

6、CKUP!,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 someConstMSGNOPWORDS

7、1 As String = "There were no passwords on " & _ "sheets, or workbook structure or windows." & AUTHORS &VERSIONConstMSGNOPWORDS2 As String = "There was no protection to " & _ "workbook structure or windows." & DBLSPACE &a

8、mp;amp; _ "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 man

9、y different passwords, the " & _ "passwords, and your computer's specification." &DBLSPACE& _"Just be patient! Make me a coffee!" & AUTHORS &VERSIONConst MSGPWORDFOUND1 As String = "You had aWorksheet " & _"S

10、tructure 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 pa

11、ssword." & DBLSPACE & _ "Now to check and clear other passwords." & AUTHORS & VERSIONConst MSGPWORDFOUND2 AsString = "You had a Worksheet " & _ "password set." & DBLSPACE &"The password found was: "

12、& _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 " &a

13、mp; _ "other passwords." & AUTHORS & VERSIONConstMSGONLYONE As String = "Only structure / windows " &"protected with the password that was just found." & _ALLCLEAR & AUTHORS &VERSION & REPBACKDim w1 As Worksheet, w

14、2 As WorksheetDim i AsInteger, j As Integer, k As Integer, l As IntegerDim m As Integer, n AsInteger, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean,WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbo

15、okWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If NotShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf NotWinTag ThenMsgBox MSGNOPWORDS2,

16、 vbInformation, HEADERElseOn ErrorResume 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

17、 .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) & Ch

18、r(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 f

19、or.nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next:Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIfWinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExitSubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1 w1.Unprotect PW

20、ord1Next w1OnError 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

21、 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 126 .UnprotectChr(i) & Chr(j) & Chr(k) & _Chr(l) & Chr(m) & Chr(i1) & C

22、hr(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) &

23、amp;amp; Chr(i6) & Chr(n)MsgBoxApplication.Substitute(MSGPWORDFOUND2, _ "$", PWord1), vbInformation,HEADER 'leverage finding Pword by trying on other sheetsFor Each w2 InWorksheets w2.Unprotect PWord1Next w2Exit Do 'Bypass all for.nextsEnd IfNext: Next: Next: Next: Next: Ne

24、xtNext: Next:Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS &VERSION & REPBACK, vbInformation, HEADEREnd SubEXCEL 工程密破解 ,以下方法十分有效的帮你打开VBA 工程密码保护的工程 ,教你破解 VBA 工程密码 ,解除VBA 工程密码保护下的 EXCEL 文档 ,破解 EXCEL 原来如此简单.在办公中我们常看到许多用宏

25、 (VBA) 编写的EXCEL 表格 ,而这些表格就如同一个数据库 ,我们可以选取或查询很多的数据 ,一般的这些数据是存放在一个隐藏的工作表中的 ,那么要如何显示这个隐藏的工作表呢?我们可以打开宏编辑器 (ALT+F11), 再安 CTRL+R 打开专案 ,这时弹出窗会有所有的这个 EXCEL 的工用表 ,这时你就可以看看那些是被隐藏的了 ,很多时候打开是需要密码的 ,用以下方法解密后 ,再将解密后文件打开 ,依同样方法在工作表标签中右键 >>检视程式码 >> 复制以下代码 >> 按 F8 执行 Private

26、Sub CommandButton1_Click()Worksheets(" 这里为你要显示的工作表名称 ").Visible = TrueEnd Sub 关于破解 EXCELVBA 工程密码的方法 ,以下代码非常有效 ,首先建一新EXCEL 文件 ,在工作表标签处右点 >> 检视程式码>> 复制以下代码 >> 按 F8 执行在弹出窗中选你要你破解工程密码的EXCEL 文件>> 再按 F5 执行即可 .Private Sub VBAPassword()'你要解保护的 Excel 文件路径Filename =Application.GetOpenFilename("Excel 文件( *.xls & *.xl