取消EXCEL工作表保护密码的vba方法

　EXCEL工作表为了保护数据被更改设置表格保护，但是有时候在无意中设置了表格保护或者保护密码忘记了无法继续修改文件，这样给工作带来不便。那么密码忘记了怎么继续修改文件呢？编者结合实际操作为你解答。

视图—宏—录制新宏—输入宏名如:aa（aa是可随意输入）

停止录制，这样得到一个空宏

同样视图—宏—查看宏—选aa（aa为之前新建的宏）—点击编辑按钮　　　

删除窗口中的所有字符，复制下面的内容粘贴。一个字母、标点符号都不能少。

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

复制代码

关闭编辑窗口

视图—宏—查看宏,选AllInternalPasswords，点击执行，确定两次，等2分钟，再确定。密码撤销完毕。

在弹出的两次确定中，有一个会显示得出来的密码是什么。

这就是Excel密码对应的原始密码(此密码和原先设置的密码都能打开此文档。如果是别人的文档，你又想恢复密码设置，就可以用此密码进行保护，他就能用他设置的密码打开，你可以试试，很有趣的。字母一定要大写)，但这个密码不是作者设置的密码。

该代码告诉我们一个规则，无论设置什么密码，系统都将转换成一个12位的密码，其中前11位字符A或者B，最后一位字符代码为32-126，如：
密码“a”，将转换成“AAABAABBBBB6”；
密码“b"，将转换成“AABABBAAAAAG”；
密码“abcde”，将转换成“AABBBABBBBAW”；
密码“12345”，将转换成“AABBAABBBAAW”等等。
转换前后的密码是通用的，如设置密码“a”，可用“AAABAABBBBB6”撤销，反过来，设置密码“AAABAABBBBB6”，也可用“a“撤销。

该代码告诉我们第二个信息，工作表保护的密码共有2^11*95=194560个，其中有一个可以撤销你的工作表保护。

至于转换规则，不得而知。





或者直接下载下面的附件： 去除Excel工作表保护密码.txt (5.92 KB, 下载次数: 122)

2019-3-5 10:57 上传

点击文件名下载附件

然后按下面的方法使用。

操作步骤：
1. 打开需要破解密码的Excel；
2. Alt+F11，进入VBA编辑界面；
3. 插入 -- 模块(Module)；
4. 在右边Module的空白编辑区域，复制粘贴下面所有内容；
5. F5，运行该VBA命令；