Excel工作表保护宏破解教程

有部分Excel工作表设置了读取权限。有时候忘记了所设置的代码，作者就无法进行对工作表的编辑和修改。为了方便大家，介绍一个方法进行工作表保护机制的“缴械”处理 （1）打开Excel工作表，点击工作表左上角的微软图案标志。选择Excel选项。进入选项卡，选择Excel选项。在Excel选项卡左侧选择如下功能：

A-查看宏；
B-录制宏；
C-查看权限
D-无限制的访问
E-限制访问
F-权限限制

（2）选择信任中心选项卡。进入信任中心选项卡后，选择点击信任中心设置按钮。选择宏设置选项卡的第二项单项选择：禁止所有宏，并发出通知。
（3）新建工作表，选择录制宏命令。如果是Excel2007，可以通过菜单中的开发工具进入录制宏选项卡。建立宏名称和说明，点击确定。系统开始录制宏。选择停止录制宏。
（4） 按下快捷键ALT F8组合键，选择查看宏命令代码。写入如下代码：

ASP/Visual Basic Code 复制内容到剪贴板

1. Public Sub 工作表保护密码破解()   
2. Const DBLSPACE As String = vbNewLine & vbNewLine   
3. Const AUTHORS As String = DBLSPACE & vbNewLine & _   
4. "作者:圣天"  
5. Const HEADER As String = "工作表保护密码破解"  
6. Const VERSION As String = DBLSPACE & "版本 Version1.1.1"  
7. Const REPBACK As String = DBLSPACE & ""  
8. Const ZHENGLI As String = DBLSPACE " XXXXXXX"  
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 InWorksheets   
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.   
39.   
40. If Not WinTag Then  
41. Else  
42. On Error Resume Next  
43. Do &39;dummy do loop   
44. For i = 65 To 66: For j = 65 To 66: For k = 65 To 66   
45. For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66   
46. For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66   
47. For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126   
48. With ActiveWorkbook   
49. .Unprotect Chr(i) & Chr(j) & Chr(k) & _   
50. Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _   
51. Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
52. If .ProtectStructure = False And _   
53. .ProtectWindows = False Then  
54. PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _   
55. Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _   
56. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
57. MsgBox Application.Substitute(MSGPWORDFOUND1, _   
58. "$$", PWord1), vbInformation, HEADER   
59. Exit Do &39;Bypass all for...nexts   
60. End If  
61. End With  
62. Next: Next: Next: Next: Next: Next  
63. Next: Next: Next: Next: Next: Next  
64. Loop Until True  
65. On Error GoTo 0   
66. End If  
67. If WinTag And Not ShTag Then  
68. MsgBox MSGONLYONE, vbInformation, HEADER   
69. Exit Sub  
70. End If  
71. On Error Resume Next  
72. For Each w1 InWorksheets   
73. &39;Attempt clearance with PWord1   
74. w1.Unprotect PWord1   
75. Next w1   
76. On Error GoTo 0   
77. ShTag = False  
78. For Each w1 InWorksheets   
79. &39;Checks for all clear ShTag triggered to 1 if not.   
80. ShTag = ShTag Or w1.ProtectContents   
81. Next w1   
82. If ShTag Then  
83. For Each w1 InWorksheets   
84. With w1   
85. If .ProtectContents Then  
86. On Error Resume Next  
87. Do &39;Dummy do loop   
88. For i = 65 To 66: For j = 65 To 66: For k = 65 To 66   
89. For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66   
90. For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66   
91. For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126   
92. .Unprotect Chr(i) & Chr(j) & Chr(k) & _   
93. Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _   
94. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
95. If Not .ProtectContents Then  
96. PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _   
97. Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _   
98. Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)   
99. MsgBox Application.Substitute(MSGPWORDFOUND2, _   
100. "$$", PWord1), vbInformation, HEADER   
101. &39;leverage finding Pword by trying on other sheets   
102. For Each w2 InWorksheets   
103. w2.Unprotect PWord1   
104. Next w2   
105. Exit Do 'Bypass all for...nexts   
106. End If  
107.   
108.   
109. Next: Next: Next: Next: Next: Next  
110. Next: Next: Next: Next: Next: Next  
111. Loop Until True  
112. On Error GoTo 0   
113. End If  
114. End With  
115. Next w1   
116. End If  
117. MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI,vbInformation, HEADER   
118. End Sub  

（5）写入代码完成后，保存宏命令。点击执行宏命令，等待一盏茶的时间，工作簿保护密码就“缴械”了。注意记录密码和更改密码，便于后续试用方便。
（6）特别声明：严谨用于违反犯罪行为！
上一篇：Word/wps怎么打印背景图片？Word背景打印不出来的三种解决办法 下一篇：如何在Word中插入图片并进行图片设置?

相关文章

• Word教程 Word文档怎么比较不同内容

  Word文档怎么比较不同内容呢？很多用户对此还不是很清楚，小编这里就给大家带来有关Word文档怎么比较不同内容的回答，希望能够帮助大家了解。......

  2023-01-19

  详细阅读
• Word教程 Word文档怎么拆分

  Word文档怎么拆分成多个文档呢？很多用户对此还不是很清楚，小编这里就给大家带来有关Word文档怎么拆分的回答，希望能够帮助大家了解。......

  2023-01-19

  如何在Word中插入图片并进行图片设置?

  如何在Word中插入图片并进行图片设置?很多朋友都不是很清楚，其实方法很简单的，下面小编就为大家详细介绍一下，来看看吧

  详细阅读
• Word教程 Word不规则表格的制作方法

  Word不规则表格的制作方法是什么呢？很多用户对此还不是很清楚，小编这里就给大家带来有关Word不规则表格的制作方法的回答，希望能够帮助大家了解。......

  2023-01-19

  详细阅读
• Word教程 Word文本框怎么自动调整大小

  Word文本框怎么自动调整大小呢？很多用户对此还不是很清楚，小编这里就给大家带来有关Word文本框怎么自动调整大小的回答，希望能够帮助大家了解。......

  2023-01-19

  详细阅读
• Word教程 Word文档忘记保存怎么办

  Word文档忘记保存怎么办呢？很多用户对此还不是很清楚，小编这里就给大家带来有关Word文档忘记保存怎么办的回答，希望能够帮助大家了解。......

  2023-01-19

  详细阅读

word文件如何快捷合并邮件?

word文件如何快捷合并邮件?很多朋友都不是很清楚，其实方法很简单的，下面小编就为大家详细介绍一下，不会的朋友可以过来参考一下，来看看吧