破解工作表密码/共享excel表锁定破解 - pyman - 博客园
把他干掉，今天试验，真实有效。
今天下载了一个Excel2003文档，对里面的一些函数甚是感兴趣，但郁闷的是作者对文档进行了加密，有函数的地方全部设成只读属性了！在Excel的菜单中点击&撤销工作表&,提示输入密码!原来如此,上网搜了一个VBA宏破解的方法,一下就成功了啊!牛人还真的多啊!不得不佩服啊,下面就说一下这个方法吧
1．& 点击&宏&&&宏&，出现窗口，在&宏名&定义一个名称为：PasswordBreaker，点击&创建&，然后关闭弹出的窗口，退出;
2．& 再点击&宏&&&宏&，选择&宏名&下的&PasswordBreaker&并点击&编辑&，打开&Microsoft Visual Basic&编辑器，用如下内容替换右侧窗口中的所有代码：　　Sub PasswordBreaker()　　Dim i As Integer, j As Integer, k As Integer　　Dim l As Integer, m As Integer, n As Integer　　Dim i1 As Integer, i2 As Integer, i3 As Integer　　Dim i4 As Integer, i5 As Integer, i6 As Integer　　On Error Resume Next　　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　　ActiveSheet.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 ActiveSheet.ProtectContents = False Then　　MsgBox "One usable password is " & Chr(i) & Chr(j) & _　　Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _　　Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)　　ActiveWorkbook.Sheets(1).Select　　Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _　　Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _　　Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)　　Exit Sub　　End If　　Next: Next: Next: Next: Next: Next　　Next: Next: Next: Next: Next: Next　　End Sub
3．& 再点击&宏&&&宏&，选择&宏名&下的&PasswordBreaker&并点击&执行&，密码就现形了，有个弹出对话窗口的，告诉你一个可以用的密码。哈哈，好牛啊。
听说：在Excel2007中打开的,根本就不需要撤销密码保护,直接就可以了啊!而且也没有&撤销工作表保护&的菜单。这个我没有试验过..
,今天的重要任务是破解一个局域网上共享的 excel工作簿.用我以往学习的方法一一尝试,不行啊。焦急中。..上网度娘了一下，找到了个好用的破解文件AdvancedOfficePasswordRecovery_hhw2013ok.exe 我就根据情况使用如下:
1、局域网上共享的 excel工作簿允许多人同时编辑。现在一编辑，保存时候就弹出框&文件已锁定，请梢后再试&。我重新启动了文件所在的服务器，也不行。
2、考虑到是否有人在编辑该文件时候发生故障，导致线程缩定。不给编辑。。。但考虑到现象不相似，如果这样的话，文件的提示将会是：&给xx用户编辑/琐定& 字样。所以否定该方向。
3、用在工作簿内建宏再破解密码的方法，但操作到建立 宏 的时候，却被告诉 录制新宏不能保存在当前工作簿（因为该工作簿共享），而解除该工作簿保护，又需要有密码，这样冲突，解决不了。
4、在经过考虑，还是认为解除工作簿保护，还是要破解密码为上策。所以，就用AdvancedOfficePasswordRecovery打开文件，然后破解得到密码，然后该对话框中有个&打开&的按钮（文件路径已经具备好，不用理会）。关键点来了。如果这时候你&& 工具 ---保护---撤消工作簿保护 ，输入密码，悲剧，这样是不行的。因为还是得到&文件已锁定，请梢后再试&的对话框。这时候，你需要做的是首先把该打开的文件另存为一个例如名aa的文件。然后，关闭所有，再打开该aa文件，发现是是共享的。你在& 工具 ---保护---撤消工作簿保护 ，输入密码，ok，这时候，你会欣喜地发现，&共享&的字样已经没有了。你成功了。如果你再想加保护，则&&工具 ---保护---保护共享工作簿 ，追踪修订方式打勾，输入密码，你又可以保护你的工作簿了。
到这里，解决了问题。上传该破解文件，很好用。对付ms的文件密码。
Blog Stats
随笔 - 143
Trackbacks - 1求助请问一下有哪位晓得EXCEL的咋撤销工作表保护？　有点着急了啊，我在此先谢了各位 已关闭 - 办公软件 -
- Powered by Discuz!
求助请问一下有哪位晓得EXCEL的咋撤销工作表保护？　有点着急了啊，我在此先谢了各位 已关闭
或是重新下载一个宏下来。或是格式化系统，重装。
相关主题：
在“工具”菜单上，指向“保护”，然后单击“保护工作簿”。 请执行下列一项或多项操作： 如果要保护工作簿的结构，请选中“结构”复选框，这样工作簿中的工作表将不能进行移动、删除、隐藏、取消隐藏或重新命名，而且也不能插入新的工作表。 如果要
你好！ 你的这个问题，我的回答虽然不能完全针对。但是对你却可能恰恰十分适合。 因为我猜测可能你的视力不太好吧。也许需要调大的不止是表签中的字体了。 我建议： 鼠标随意点到文档中任何位置，左手按住CTRL，右手前推鼠标滚轮。哈哈
晓得保护密码
使用密码破解软件，往掉所有密码
大约跑了两百多米远，瞅到一个熟人骑着摩托车路过
我被醉倒在那藤林的相思屋中
这个男孩或许是年纪小的缘故吧，他根本不晓得人死不能复活
我们坐在那黄昏的院落
啊·我们全部笑了
是不晓得咋操作仍是密码忘记了？
假若工作表用了密码来进行工作表保护，便要输入密码才能撤销保护。假若您没密码，能发过来帮您解除保护。@qq
工具-保护-撤消工作表保护。
点&工具&-&&选项&-&&视图&-&&工作表标签&画勾. 就会出现所有的工作表了. 不知道你问的是不是这个意思.
很简单的，解密小工具已发给，查收。s d h j _ c h e n
[通过 QQ、MSN 分享给朋友]您还未登陆，请登录后操作！
你好，很感谢你的帮助，那个撤销工作表保护怎么需要验证密码，
撤销工作表保护密码是1
,那只能说是工作薄保护；
工作薄保护是为了保护整个工作簿的结构不至于被使用者修改,破坏，或者各表之间有相互联系的，比如表1的某列数据有效性设置来源是表2的某行的范围。一般这种工作薄是为某一目的而制作的。
受工作薄密码保护的各表是不能被使用者删除的，除非整个文件都删除掉。
这个保护只有当初制作该工作薄的人才能撤销保护，因为他才知道保护密码,即所谓的验证密码。
愿我的解答能令你满意！
您的举报已经提交成功，我们将尽快处理，谢谢！
大家还关注excel工作表里边的撤销保护工作表密码破解
　　EXCEL密码破解/破解工作表保护密码(详细图文教程)EXCEL密码破解/破解工作表保护密码(详细图文教程)网上有很多这个代码，但很多朋友并不太了解如何运用在此做了一些整理，希望对大家有所帮助！注：很多时候会因为忘记密码丢失重要EXCEL文件而烦恼，这份代码就能帮你找回，仅仅出之这个初衷，如因为这个代码让你感到不安全，那请加强电脑文件的密保，如用在不当的地方，后果自负！EXCEL密码破解/破解工作表保护密码1、新建一个EXCEL文件“BOOK1”，在工具栏空白位置，任意右击，选择Visual Basic项，弹出Visual Basic工具栏：2、在Visual Basic工具栏中，点击“录制”按钮，弹出“录制新宏”对话框，选择“个人宏工作簿”：3、选择“个人宏工作簿”后按确定，弹出如下“暂停”按钮，点击停止：4、在Visual Basic工具栏中，点击“编辑”按钮：5、点击“编辑”按钮后，弹出如下图的编辑界面：找到“VBAProject（PERSONAL.XLS）－模块－模块1（也可能是模块N-其他数字）”双击模块1－将右边代码内容清空6、复制“工作保护密码破解”代码到右边框中，点保存，然后关闭“BOOK1”7、运行需要解密的“EXCEL文件”，在Visual Basic工具栏中，点击“运行”按钮8、点击“运行”按钮后，弹出“宏”对话框，点击运行“PERSONAL.XLS!工作保护密码破解”这个宏9、运行“PERSONAL.XLS!工作保护密码破解”这个宏后，如下图示意就可以 解除工作表的密码保护了（这个图，如果工作表中有多组不同密码，每解开一组，就会提示一次，也就说可能会出现几次）工作表保护密码破解(代码）=========请复制以下内容=============Public Sub 工作表保护密码破解()Const DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _"作者:McCormick&& JE McGimpsey "Const HEADER As String = "工作表保护密码破解"Const VERSION As String = DBLSPACE & "版本 Version 1.1.1"Const REPBACK As String = DBLSPACE & ""Const ZHENGLI As String = DBLSPACE & "&&&&&&&&&&&&&&&&&& hfhzi3—戊冥 整理"Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！"Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!"Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _"如果该文件工作表有不同密码,将搜索下一组密码并修改清除"Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _"如果该文件工作表有不同密码,将搜索下一组密码并解除"Const MSGONLYONE As String = "确保为唯一的?"Dim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenElseOn Error Resume NextDo 'dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126With 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 ThenPWord1 = 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, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not.ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For 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 ThenPWord1 = 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 sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADEREnd Sub=========================================================（图1）（图2）&工作表保护密码破解放代码&是放在VBAProject(PERSONAL.XLS)[个人宏工作簿]——[模块]中的，如上图是放在红色标号2[模块1]中来自: 我的excel工作表里边的撤销保护工作表密码忘记了，谁能给我发个破解密码的软件？ 11:23提问者：
| 浏览次数：3454次打开excel表格——工具——保护——撤销工作表保护， 有没有人能给发个软件破解一下啊？？\打开文件 2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容:(你复制吧) Option ExplicitPublic 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 BooleanApplication.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 Sub6\关闭编辑窗口 7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了 这个方法适用于03版的
来自：&&&《》
更多精彩，关注微信号：360doc
馆友评论（0）
您好，请&&或者&&后再进行评论
合作登录：
(window.slotbydup = window.slotbydup || []).push({
container: s,
id: 'u1442766',
scale: '20.3',
display: 'inlay-fix'1203人阅读
1、打开您需要撤销保护密码的Excel文件；2、依次点击菜单栏上的工具---宏----录制新宏，输入宏名字如:ab；3、停止录制(这样得到一个空宏)；4、依次点击菜单栏上的工具---宏----宏,选ab,点编辑按钮；5、删除窗口中的所有字符(只有几个),替换为以下内容；Public Sub 工作表保护密码()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine
Const HEADER As String = &工作表保护密码&
Const VERSION As String = DBLSPACE & &版本 Version 1.1.2&
Const REPBACK As String = DBLSPACE & &&
Const ZHENGLI As String = DBLSPACE & &
Const ALLCLEAR As String = DBLSPACE & &该工作簿中的工作表密码保护已全部解除。& & DBLSPACE & &请记得重新设置密码& _
& DBLSPACE & &注意：此方法仅用于遗忘密码使用。&
Const MSGNOPWORDS1 As String = &该文件工作表中没有加密&
Const MSGNOPWORDS2 As String = &该文件工作表中没有加密2&
Const MSGTAKETIME As String = &请耐心等候!& & DBLSPACE & &按确定开始回复&
Const MSGPWORDFOUND1 As String = &密码重新组合为:& & DBLSPACE & &$$& & DBLSPACE & _
&如果该文件工作表有不同密码,将搜索下一组密码并修改清除&
Const MSGPWORDFOUND2 As String = &密码重新组合为:& & DBLSPACE & &$$& & DBLSPACE & _
&如果该文件工作表有不同密码,将搜索下一组密码并解除&
Const MSGONLYONE As String = &确保为唯一的?&
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
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
If Not ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation, HEADER
MsgBox MSGTAKETIME, vbInformation, HEADER
If Not WinTag 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
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
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
If WinTag And Not ShTag Then
MsgBox MSGONLYONE, vbInformation, HEADER
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
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
If ShTag Then
For Each w1 In Worksheets
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
Exit Do 'Bypass all for...nexts
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER
End Sub6、关闭编辑窗口；7、依次点击菜单栏上的工具---宏-----宏,选AllInternalPasswords,运行,确定两次，等候一两分钟,会出现以下对话框：&& 这是Excel密码对应的原始密码(此密码和之前设置的密码均能打开此文档。
* 以上用户言论只代表其个人观点，不代表CSDN网站的观点或立场
访问：818763次
积分：10479
积分：10479
排名：第595名
原创：186篇
转载：169篇
评论：327条
(1)(3)(5)(4)(1)(1)(2)(2)(1)(1)(2)(3)(3)(1)(1)(1)(1)(1)(3)(3)(2)(3)(3)(3)(2)(1)(3)(2)(1)(6)(7)(3)(5)(2)(5)(4)(2)(2)(1)(3)(1)(1)(1)(2)(1)(2)(1)(3)(2)(3)(1)(4)(6)(7)(4)(3)(12)(6)(13)(19)(6)(16)(13)(9)(3)(2)(4)(4)(6)(8)(2)(6)(8)(1)(6)(1)(1)(9)(12)(1)(12)(28)(8)(1)(1)}