EXCEL工作表为了保护数据被更改设置表格保护,但是有时候在无意中设置了表格保护或者保护密码忘记了无法继续修改文件,这样给工作带来不便。那么密码忘记了怎么继续修改文件呢?编者结合实际操作为你解答。
视图—宏—录制新宏—输入宏名如:aa(aa是可随意输入)
停止录制,这样得到一个空宏
同样视图—宏—查看宏—选aa(aa为之前新建的宏)—点击编辑按钮
删除窗口中的所有字符,复制下面的内容粘贴。一个字母、标点符号都不能少。 - Option Explicit
- Public Sub AllInternalPasswords()
- ' Breaks worksheet and workbook structure passwords. Bob McCormick
- ' probably originator of base code algorithm modified for coverage
- ' of workbook structure / windows passwords and for multiple passwords
- '
- ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
- ' Modified 2003-Apr-04 by JEM: All msgs to constants, and
- ' eliminate one Exit Sub (Version 1.1.1)
- ' Reveals hashed passwords NOT original passwords
- Const DBLSPACE As String = vbNewLine & vbNewLine
- Const AUTHORS As String = DBLSPACE & vbNewLine & _
- "Adapted from Bob McCormick base code by" & _
- "Norman Harker and JE McGimpsey"
- Const HEADER As String = "AllInternalPasswords User Message"
- Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
- Const REPBACK As String = DBLSPACE & "Please report failure " & _
- "to the microsoft.public.excel.programming newsgroup."
- Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
- "now be free of all password protection, so make sure you:" & _
- DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
- DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
- DBLSPACE & "Also, remember that the password was " & _
- "put there for a reason. Don't stuff up crucial formulas " & _
- "or data." & DBLSPACE & "Access and use of some data " & _
- "may be an offense. If in doubt, don't."
- Const MSGNOPWORDS1 As String = "There were no passwords on " & _
- "sheets, or workbook structure or windows." & AUTHORS & VERSION
- Const MSGNOPWORDS2 As String = "There was no protection to " & _
- "workbook structure or windows." & DBLSPACE & _
- "Proceeding to unprotect sheets." & AUTHORS & VERSION
- Const MSGTAKETIME As String = "After pressing OK button this " & _
- "will take some time." & DBLSPACE & "Amount of time " & _
- "depends on how many different passwords, the " & _
- "passwords, and your computer's specification." & DBLSPACE & _
- "Just be patient! Make me a coffee!" & AUTHORS & VERSION
- Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
- "Structure or Windows Password set." & DBLSPACE & _
- "The password found was: " & DBLSPACE & "$" & DBLSPACE & _
- "Note it down for potential future use in other workbooks by " & _
- "the same person who set this password." & DBLSPACE & _
- "Now to check and clear other passwords." & AUTHORS & VERSION
- Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
- "password set." & DBLSPACE & "The password found was: " & _
- DBLSPACE & "$" & DBLSPACE & "Note it down for potential " & _
- "future use in other workbooks by same person who " & _
- "set this password." & DBLSPACE & "Now to check and clear " & _
- "other passwords." & AUTHORS & VERSION
- Const MSGONLYONE As String = "Only structure / windows " & _
- "protected with the password that was just found." & _
- ALLCLEAR & AUTHORS & VERSION & REPBACK
- Dim w1 As Worksheet, w2 As Worksheet
- Dim i As Integer, j As Integer, k As Integer, l As Integer
- Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
- Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
- Dim PWord1 As String
- Dim ShTag As Boolean, WinTag As Boolean
- Application.ScreenUpdating = False
- With ActiveWorkbook
- WinTag = .ProtectStructure Or .ProtectWindows
- End With
- ShTag = False
- For Each w1 In Worksheets
- ShTag = ShTag Or w1.ProtectContents
- Next w1
- If Not ShTag And Not WinTag Then
- MsgBox MSGNOPWORDS1, vbInformation, HEADER
- Exit Sub
- End If
- MsgBox MSGTAKETIME, vbInformation, HEADER
- If Not WinTag Then
- MsgBox MSGNOPWORDS2, vbInformation, HEADER
- Else
- On Error Resume Next
- Do 'dummy do loop
- For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
- For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
- For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
- For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
- With ActiveWorkbook
- .Unprotect Chr(i) & Chr(j) & Chr(k) & _
- Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
- Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
- If .ProtectStructure = False And _
- .ProtectWindows = False Then
- PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
- Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
- Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
- MsgBox Application.Substitute(MSGPWORDFOUND1, _
- "$", PWord1), vbInformation, HEADER
- Exit Do 'Bypass all for...nexts
- End If
- End With
- Next: Next: Next: Next: Next: Next
- Next: Next: Next: Next: Next: Next
- Loop Until True
- On Error GoTo 0
- End If
- If WinTag And Not ShTag Then
- MsgBox MSGONLYONE, vbInformation, HEADER
- Exit Sub
- End If
- On Error Resume Next
- For Each w1 In Worksheets
- 'Attempt clearance with PWord1
- w1.Unprotect PWord1
- Next w1
- On Error GoTo 0
- ShTag = False
- For Each w1 In Worksheets
- 'Checks for all clear ShTag triggered to 1 if not.
- ShTag = ShTag Or w1.ProtectContents
- Next w1
- If ShTag Then
- For Each w1 In Worksheets
- With w1
- If .ProtectContents Then
- On Error Resume Next
- Do 'Dummy do loop
- For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
- For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
- For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
- For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
- .Unprotect Chr(i) & Chr(j) & Chr(k) & _
- Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
- Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
- If Not .ProtectContents Then
- PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
- Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
- Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
- MsgBox Application.Substitute(MSGPWORDFOUND2, _
- "$", PWord1), vbInformation, HEADER
- 'leverage finding Pword by trying on other sheets
- For Each w2 In Worksheets
- w2.Unprotect PWord1
- Next w2
- Exit Do 'Bypass all for...nexts
- End If
- Next: Next: Next: Next: Next: Next
- Next: Next: Next: Next: Next: Next
- Loop Until True
- On Error GoTo 0
- End If
- End With
- Next w1
- End If
- MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
- End Sub
复制代码关闭编辑窗口
视图—宏—查看宏,选AllInternalPasswords,点击执行,确定两次,等2分钟,再确定。密码撤销完毕。
在弹出的两次确定中,有一个会显示得出来的密码是什么。
这就是Excel密码对应的原始密码(此密码和原先设置的密码都能打开此文档。如果是别人的文档,你又想恢复密码设置,就可以用此密码进行保护,他就能用他设置的密码打开,你可以试试,很有趣的。字母一定要大写),但这个密码不是作者设置的密码。
该代码告诉我们一个规则,无论设置什么密码,系统都将转换成一个12位的密码,其中前11位字符A或者B,最后一位字符代码为32-126,如:
密码“a”,将转换成“AAABAABBBBB6”;
密码“b",将转换成“AABABBAAAAAG”;
密码“abcde”,将转换成“AABBBABBBBAW”;
密码“12345”,将转换成“AABBAABBBAAW”等等。
转换前后的密码是通用的,如设置密码“a”,可用“AAABAABBBBB6”撤销,反过来,设置密码“AAABAABBBBB6”,也可用“a“撤销。
该代码告诉我们第二个信息,工作表保护的密码共有2^11*95=194560个,其中有一个可以撤销你的工作表保护。
至于转换规则,不得而知。
或者直接下载下面的附件:
去除Excel工作表保护密码.txt
(5.92 KB, 下载次数: 123)
然后按下面的方法使用。
操作步骤:
1. 打开需要破解密码的Excel;
2. Alt+F11,进入VBA编辑界面;
3. 插入 -- 模块(Module);
4. 在右边Module的空白编辑区域,复制粘贴下面所有内容;
5. F5,运行该VBA命令;
|