Excel2013 PoJie（编辑工作表受保护）密码

一米阳光

收藏于 : 2019-06-26 13:38   被转藏 : 1   

   在日常工作中，大家有时会遇到过这样的情况：使用Excel编制的报表、表格、程序等，在单元格中设置了公式、函数等，为了防止其他人修改您的设置或者防止您自己无意中修改，您可能会使用Excel的工作表保护功能，但时间久了保护密码容易忘记，这该怎么办？有时您从网上下载的Excel格式的小程序，您想修改，但是作者加了工作表保护密码，怎么办？您只要按照以下步骤操作，Excel工作表保护密码就会破解。

1：工作表受保护时(有密码)状况：

２：在在Ｅｘｃｅｌ－视图工具栏中， 点击宏＝》选择录制宏。

３：弹出＂录制宏＂的窗口，输入宏名字 如:默认的宏１，选择保存在＂个人宏工作薄＂中，然后停止录制(这样得到一个空宏，为后面添加vb代码做准备)；

ＰＳ：这里最好选择保存在＂当前工作薄＂好方便下面的点击查看宏．


４：点击“选择“个人宏工作簿”后按确定” 开始录制一会，然后在点击＂停止录制＂

５：然后停止录制宏后，点击＂查看宏＂，弹出如下编辑界面：

６：Alt+F11或者点击“编辑”后弹出  Visual Basic for Application 编辑画面 ，找到“VBAProject（PERSONAL.XLS）或者当前．ｘｌｓ名字下面的－模块－模块1（也可能是模块N-其他数字）”  双击模块1－将右边代码内容清空



７：复制下面工作表保护密码破解代码＝到刚才删除代码的位置

=========请复制以下内容=============

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

８：重新打开要破解密码的Ｅｘｃｅｌ，然后选择＂视图＂＝》宏＝》选择＂查看宏＂。

９：运行＂工作表保护密码破解＂后 出现 工作表保护密码破解 窗口然后 点击＂确定＂开始破解＂

ｐｓ：出现安全提示：＂已禁用宏＂ 需要开启宏后才能执行：

则需要去Excel 2013 选择 中=》"信任中心"=》“信用中心设置”=-》

PS：重启Excel 后在点击查看宏=》＂工作表保护密码破解” 点击执行



10：出现下面这个图，如果工作表中有多组不同密码，  每解开一组，就会提示一次，也就说可能会出现几次 .

ps:出现下面图则表示破解完成。

11：上面已经破解成功了，并取得密码了，让我们来试试对不读。点击Excel2013菜单栏=>"审阅"=》“撤销工作表保护”=》出现窗口让我们输入得到的"AABBBAAABBBZ"密码：



OK，至此在Excel2013 工作表受保护破解密码到此结束。希望此文能帮助你。

Tks.
 阅读文章全部内容  
点击查看
文章点评
相关文章
一米阳光 关注

文章收藏：4736

TA的最新收藏