• 2022-09-04被罚款200元记6分.
  • 特么的.电脑风扇坏了.快递还全部停发.太难了...求求了.疫情赶紧走吧.
  • 难啊难!要钱难!
  • 更新到WordPress5.6啦
  • 有点伤心了,今年净遇到王某海这种人.
  • 难啊难...
  • 七牛的JS SDK 的文档真坑啊.
  • 蓝奏云分享部分地区无法访问需手动修改www.lanzous.com变为:www.lanzoux.com
  • 好气啊~原来使用的CDN服务商莫名其妙的给我服务取消了~
  • 遇见一个沙雕汽车人.

【小记】破解xls,excel受保护的单元表密码

杂谈 KIENG 6年前 (2019-01-20) 129018次浏览 已收录 0个吐槽 扫描二维码

考勤表之类的想要修改就需要密码...

图片我就不上了

首先,打开受保护的 Excel 表格,按“ALT”+“F11”键

点击“插入”——“模块

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

复制上面的破解代码按F5
【小记】破解 xls,excel 受保护的单元表密码
这个就是密码

然后在审阅里面数据密码就行啦!


KIENG.CN , 版权所有丨如未注明 , 均为原创丨本网站采用BY-NC-SA 4.0协议进行授权
转载请注明出处:【小记】破解 xls,excel 受保护的单元表密码
本文章链接:https://blog.kieng.cn/444.html
喜欢 (0)
KIENG
关于作者:
一个热衷网络的Man
发表我的评论
取消评论
表情 加粗 删除线 居中 斜体 签到

Hi,您需要填写昵称和邮箱!

  • 快速获取昵称
  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址