脚本之家 服务器常用软件
快捷导航
您的位置：主页 > 软件教程 > 办公软件 > word >

Excel工作表保护宏破解教程

  发布时间：2015-08-13 11:19:56   作者：佚名   我要评论
有部分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）特别声明：严谨用于违反犯罪行为！

相关文章

最新评论

关注微信公众号

扫一扫