Excel,遗忘密码后如何撤销工作表保护密码

穆穆的天

1、打开您需要撤销保护密码的Excel文件；
2、依次点击菜单栏上的工具---宏----录制新宏，输入宏名字如:ab；
3、停止录制(这样得到一个空宏)；
4、依次点击菜单栏上的工具---宏----宏,选ab,点编辑按钮；
5、删除窗口中的所有字符(只有几个),替换为以下内容；

1. Public Sub 工作表保护密码()
   
2. Const DBLSPACE As String = vbNewLine & vbNewLine
   
3. Const AUTHORS As String = DBLSPACE & vbNewLine & _
   
4. "作者:建筑资源吧 www.jzbar.net"
   
5. Const HEADER As String = "工作表保护密码"
   
6. Const VERSION As String = DBLSPACE & "版本 V2013.01"
   
7. Const REPBACK As String = DBLSPACE & ""
   
8. Const ZHENGLI As String = DBLSPACE & "                   建筑资源吧"
   
9. Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除。" & DBLSPACE & "请记得重新设置密码" _
   
10. & DBLSPACE & "注意：此方法仅用于遗忘密码使用。"
    
11. Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"
    
12. Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"
    
13. Const MSGTAKETIME As String = "请耐心等候!" & DBLSPACE & "按确定开始回复"
    
14. Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _
    
15. "如果该文件工作表有不同密码,将搜索下一组密码并修改清除"
    
16. Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _
    
17. "如果该文件工作表有不同密码,将搜索下一组密码并解除"
    
18. Const MSGONLYONE As String = "确保为唯一的?"
    
19. Dim w1 As Worksheet, w2 As Worksheet
    
20. Dim i As Integer, j As Integer, k As Integer, l As Integer
    
21. Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
    
22. Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
    
23. Dim PWord1 As String
    
24. Dim ShTag As Boolean, WinTag As Boolean
    
25. Application.ScreenUpdating = False
    
26. With ActiveWorkbook
    
27. WinTag = .ProtectStructure Or .ProtectWindows
    
28. End With
    
29. ShTag = False
    
30. For Each w1 In Worksheets
    
31. ShTag = ShTag Or w1.ProtectContents
    
32. Next w1
    
33. If Not ShTag And Not WinTag Then
    
34. MsgBox MSGNOPWORDS1, vbInformation, HEADER
    
35. Exit Sub
    
36. End If
    
37. MsgBox MSGTAKETIME, vbInformation, HEADER
    
38. If Not WinTag Then
    
39. Else
    
40. On Error Resume Next
    
41. Do 'dummy do loop
    
42. For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    
43. For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    
44. For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    
45. For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    
46. With ActiveWorkbook
    
47. .Unprotect Chr(i) & Chr(j) & Chr(k) & _
    
48. Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
    
49. Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    
50. If .ProtectStructure = False And _
    
51. .ProtectWindows = False Then
    
52. PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
    
53. Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
    
54. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    
55. MsgBox Application.Substitute(MSGPWORDFOUND1, _
    
56. "$$", PWord1), vbInformation, HEADER
    
57. Exit Do 'Bypass all for...nexts
    
58. End If
    
59. End With
    
60. Next: Next: Next: Next: Next: Next
    
61. Next: Next: Next: Next: Next: Next
    
62. Loop Until True
    
63. On Error GoTo 0
    
64. End If
    
65. If WinTag And Not ShTag Then
    
66. MsgBox MSGONLYONE, vbInformation, HEADER
    
67. Exit Sub
    
68. End If
    
69. On Error Resume Next
    
70. For Each w1 In Worksheets
    
71. 'Attempt clearance with PWord1
    
72. w1.Unprotect PWord1
    
73. Next w1
    
74. On Error GoTo 0
    
75. ShTag = False
    
76. For Each w1 In Worksheets
    
77. 'Checks for all clear ShTag triggered to 1 if not.
    
78. ShTag = ShTag Or w1.ProtectContents
    
79. Next w1
    
80. If ShTag Then
    
81. For Each w1 In Worksheets
    
82. With w1
    
83. If .ProtectContents Then
    
84. On Error Resume Next
    
85. Do 'Dummy do loop
    
86. For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    
87. For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    
88. For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    
89. For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    
90. .Unprotect Chr(i) & Chr(j) & Chr(k) & _
    
91. Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
    
92. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    
93. If Not .ProtectContents Then
    
94. PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
    
95. Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
    
96. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    
97. MsgBox Application.Substitute(MSGPWORDFOUND2, _
    
98. "$$", PWord1), vbInformation, HEADER
    
99. 'leverage finding Pword by trying on other sheets
    
100. For Each w2 In Worksheets
     
101. w2.Unprotect PWord1
     
102. Next w2
     
103. Exit Do 'Bypass all for...nexts
     
104. End If
     
105. Next: Next: Next: Next: Next: Next
     
106. Next: Next: Next: Next: Next: Next
     
107. Loop Until True
     
108. On Error GoTo 0
     
109. End If
     
110. End With
     
111. Next w1
     
112. End If
     
113. MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER
     
114. End Sub
     

复制代码

6、关闭编辑窗口；
7、依次点击菜单栏上的工具---宏-----宏,选AllInternalPasswords,运行,确定两次，等候一两分钟,会出现以下对话框：
   这是Excel密码对应的原始密码(此密码和之前设置的密码均能打开此文档。

本文永久链接地址：https://www.jzbar.net/thread-1592-1-1.html

春风_绿叶

多谢分享的xls去密码保护的方法

熬夜的鹿

宏命令吗？方法不对啊？

图集

我这有两个强力破解密码的工具哈。。

庆云

图集 发表于 2013-11-28 09:41
我这有两个强力破解密码的工具哈。。

暴力哪个好像不好用吧，我也有一个，是用穷举编遍列的方式去猜密码。效率不高啊。

0539学习者

谢谢分享，学习学习。