Excel 工作表，单元格破解密码宏

  1'1、 打开要破解的EXCEL文件|
  2
  3'2、 工具---宏----录制新宏---输入名字如:aa -----关闭
  4
  5'3、 工具---宏----停止录制(这样得到一个空宏)
  6
  7'4、 工具---宏----宏,选aa,点 编辑 按钮
  8
  9'5、 删除窗口中的所有字符(只有几个),替换为下面解压后文件中内容
 10
 11'Excel密码破解.rar
 12
 13'6、关闭编辑窗口
 14
 15'7、工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!
 16
 17
 18
 19
 20
 21
 22Option Explicit 
 23
 24Public Sub AllInternalPasswords() 
 25' Breaks worksheet and workbook structure passwords. Bob McCormick 
 26' probably originator of base code algorithm modified for coverage 
 27' of workbook structure / windows passwords and for multiple passwords 
 28' 
 29' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 
 30' Modified 2003-Apr-04 by JEM: All msgs to constants, and 
 31' eliminate one Exit Sub (Version 1.1.1) 
 32' Reveals hashed passwords NOT original passwords 
 33Const DBLSPACE As String = vbNewLine & vbNewLine 
 34Const AUTHORS As String = DBLSPACE & vbNewLine & _ 
 35"Adapted from Bob McCormick base code by" & _ 
 36"Norman Harker and JE McGimpsey" 
 37Const HEADER As String = "AllInternalPasswords User Message" 
 38Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" 
 39Const REPBACK As String = DBLSPACE & "Please report failure " & _ 
 40"to the microsoft.public.excel.programming newsgroup." 
 41Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ 
 42"now be free of all password protection, so make sure you:" & _ 
 43DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ 
 44DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 
 45DBLSPACE & "Also, remember that the password was " & _ 
 46"put there for a reason. Don't stuff up crucial formulas " & _ 
 47"or data." & DBLSPACE & "Access and use of some data " & _ 
 48"may be an offense. If in doubt, don't." 
 49Const MSGNOPWORDS1 As String = "There were no passwords on " & _ 
 50"sheets, or workbook structure or windows." & AUTHORS & VERSION 
 51Const MSGNOPWORDS2 As String = "There was no protection to " & _ 
 52"workbook structure or windows." & DBLSPACE & _ 
 53"Proceeding to unprotect sheets." & AUTHORS & VERSION 
 54Const MSGTAKETIME As String = "After pressing OK button this " & _ 
 55"will take some time." & DBLSPACE & "Amount of time " & _ 
 56"depends on how many different passwords, the " & _ 
 57"passwords, and your computer's specification." & DBLSPACE & _ 
 58"Just be patient! Make me a coffee!" & AUTHORS & VERSION 
 59Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ 
 60"Structure or Windows Password set." & DBLSPACE & _ 
 61"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 
 62"Note it down for potential future use in other workbooks by " & _ 
 63"the same person who set this password." & DBLSPACE & _ 
 64"Now to check and clear other passwords." & AUTHORS & VERSION 
 65Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 
 66"password set." & DBLSPACE & "The password found was: " & _ 
 67DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 
 68"future use in other workbooks by same person who " & _ 
 69"set this password." & DBLSPACE & "Now to check and clear " & _ 
 70"other passwords." & AUTHORS & VERSION 
 71Const MSGONLYONE As String = "Only structure / windows " & _ 
 72"protected with the password that was just found." & _ 
 73ALLCLEAR & AUTHORS & VERSION & REPBACK 
 74Dim w1 As Worksheet, w2 As Worksheet 
 75Dim i As Integer, j As Integer, k As Integer, l As Integer 
 76Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer 
 77Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 
 78Dim PWord1 As String 
 79Dim ShTag As Boolean, WinTag As Boolean 
 80
 81Application.ScreenUpdating = False 
 82With ActiveWorkbook 
 83WinTag = .ProtectStructure Or .ProtectWindows 
 84End With 
 85ShTag = False 
 86For Each w1 In Worksheets 
 87ShTag = ShTag Or w1.ProtectContents 
 88Next w1 
 89If Not ShTag And Not WinTag Then 
 90MsgBox MSGNOPWORDS1, vbInformation, HEADER 
 91Exit Sub 
 92End If 
 93MsgBox MSGTAKETIME, vbInformation, HEADER 
 94If Not WinTag Then 
 95MsgBox MSGNOPWORDS2, vbInformation, HEADER 
 96Else 
 97On Error Resume Next 
 98Do 'dummy do loop 
 99For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 
100For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 
101For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 
102For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 
103With ActiveWorkbook 
104.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 
105Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ 
106Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 
107If .ProtectStructure = False And _ 
108.ProtectWindows = False Then 
109PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 
110Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 
111Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 
112MsgBox Application.Substitute(MSGPWORDFOUND1, _ 
113"$$", PWord1), vbInformation, HEADER 
114Exit Do 'Bypass all fornexts 
115End If 
116End With 
117Next: Next: Next: Next: Next: Next 
118Next: Next: Next: Next: Next: Next 
119Loop Until True 
120On Error GoTo 0 
121End If 
122If WinTag And Not ShTag Then 
123MsgBox MSGONLYONE, vbInformation, HEADER 
124Exit Sub 
125End If 
126On Error Resume Next 
127For Each w1 In Worksheets 
128'Attempt clearance with PWord1 
129w1.Unprotect PWord1 
130Next w1 
131On Error GoTo 0 
132ShTag = False 
133For Each w1 In Worksheets 
134'Checks for all clear ShTag triggered to 1 if not. 
135ShTag = ShTag Or w1.ProtectContents 
136Next w1 
137If ShTag Then 
138For Each w1 In Worksheets 
139With w1 
140If .ProtectContents Then 
141On Error Resume Next 
142Do 'Dummy do loop 
143For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 
144For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 
145For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 
146For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 
147.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 
148Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 
149Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 
150If Not .ProtectContents Then 
151PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 
152Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 
153Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 
154MsgBox Application.Substitute(MSGPWORDFOUND2, _ 
155"$$", PWord1), vbInformation, HEADER 
156'leverage finding Pword by trying on other sheets 
157For Each w2 In Worksheets 
158w2.Unprotect PWord1 
159Next w2 
160Exit Do 'Bypass all fornexts 
161End If 
162Next: Next: Next: Next: Next: Next 
163Next: Next: Next: Next: Next: Next 
164Loop Until True 
165On Error GoTo 0 
166End If 
167End With 
168Next w1 
169End If 
170MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 
171End Sub