excel工作表密码去除汉化版
EXCEL密码去除(工作表、工作薄密码保护破解)
各位朋友不知道有没有碰到过这样的情况，当你要打开一个EXECL工作表时，突然发现密码忘记了，唯一可做的也许是搞个破解软件来破一下，但针对打开后的工作表保护，一般就很难有效了，复制虽是一种办法，但不少数据（特别是公式较多着），可能就要乱套了，入户才能破解这一类密码呢？不久前在网上发现此精华，与大家共享一下！利用宏运行方式破解，真的很有效，运行中可能电脑有两分钟无反应，千万不要以为死机了，等等吧！步骤方法如下：1.打开文件2.工具---宏---录制新宏---输入名字如：aa3.停止录制（这样得到一个空宏）4.工具---宏----宏，选aa，点编辑按钮5.删除窗口中的所有字符（只有几个），替换为下面的内容：（复制吧）6.关闭编辑窗口7.工具---宏----宏。
选AllInternalPasswords，运行，确定两次，等两分钟，再确定，OK，没有密码了！！宏内容如下：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 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)'Reveals hashed passwords NOT original passwordsConst DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _"Adapted form 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 proteection, 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 areason. Don't stuff up crucial formulas" & _"or date/" & DBLSPACE & "Access and use of some data" & _"may be an offense.If in doubt,don't."Const MSGNOPWPRDS1 As String = "There were no passwords on" & _"sheet,or workbook struture or windows." & AUTHORS & VERSION Const MSGNOPWORD2 As String = "There was no protection to" & _ "workbook structure or windows." & DBLSPACE & _"Proceeding to unprotect sheets." & AUTHORS & VERSIONConst 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 & _"Thq 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 & VERSIONConst MSGONL YONE As String = "Only structure / windows" & _ "protected with the password that was just found." & _ALLCLEAR & AUTHORS & VERSION & REPBACKDim 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 ThenMsgBox MSGNOPWORDS2, vbInformation, HEADER ElseOn 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 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(1) & Chr(m) & Chr(i1) & Chr(i2) & _Chr(i3) & Chr(i4) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _.ProtectWindows = False ThenPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(1) & _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 MSGONL YONE, 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 triffered 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(1) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _Chr(i4) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)If Not .ProtectContents ThenPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(1) & _Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)MsgBox Application.Substitute(MSGPWORDFOUND2, _"$$", PWord1), vbInformation, HEADER'leverrage 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, vbInformation, HEADER End Sub好了，经测试有效，祝各位成功！。
ex-vba迄今为止最简单的excel工作表密码解除方法
ex-vba迄今为止最简单的excel工作表密码解除方法
『动画解读』
对于设置了工作表密码的工作簿，打开后，具体操作步骤如下：
Step-01：通过菜单【开发工具】-【Visual Basic】进入VBA 编辑界面
Step-02：在VBA编辑窗口的【立即窗口】中逐步执行以下代码（输完一句回车后再输入另一句并回车其中sheet1为需要破解密码的工作表的名称）sheet1.Protect AllowFiltering:=truesheet1.unProtect
逐步执行这两行代码后，工作表的密码将被解除！！！
如果打开VBA编辑窗口时没有立即窗口，可以通过菜单【视图】-【立即窗口】调出来，如下图所示：
『扩展应用』如果需要批量解除的，可以自行加入循环控制语句，写成一个过程。
代码参考如下（将代码复制放在ThisWorkbook下，然后运行）：Sub clsWkShtPwd() Dim sht As Worksheet For Each sht In Worksheets
sht.Protect AllowFiltering:=True sht.unprotect NextEnd Sub
在此再次感谢大神们的分享！同时，一门技术是好是坏，全凭个人掌握，用于益处是为好……。
excel去掉密码的方法
excel去掉密码的方法Excel是一款非常广泛使用的电子表格软件，它可以帮助用户进行数据分析、计算、图表制作等操作。
但是，有时候我们会在Excel 表格中设置密码保护，以保护机密数据或防止其他人修改表格内容。
然而，当我们忘记密码或者需要修改内容时，我们可能需要去掉Excel 文件的密码保护。
下面是几种去掉Excel密码的方法。
方法一：使用密码破解工具有一些软件可以帮助用户去除Excel表格的密码，例如Excel Password Recovery、PassFab for Excel等。
这些软件可以帮助用户破解Excel表格的密码，让用户可以重新访问受保护的Excel文件。
方法二：使用VBA宏代码如果用户对VBA有一定的了解，可以通过编写宏代码来去除Excel文件的密码保护。
用户可以按照以下步骤进行操作：1. 打开受保护的Excel文件，并按下Alt + F11打开VBA编辑器。
2. 在VBA编辑器中，选择项目资源管理器中的“ThisWorkbook”。
3. 在“ThisWorkbook”中，粘贴以下代码并运行：```VBASub PasswordBreaker()Dim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor 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 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) & i1 & i2 & i3 & i4 & i5 & i6 & Chr(n) If ActiveSheet.ProtectContents = False ThenMsgBox '密码破解成功，密码为：' & Chr(i) & Chr(j) & _Chr(k) & Chr(l) & Chr(m) & i1 & i2 & i3 & i4 & i5 & i6 & Chr(n)Exit SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd Sub```该宏代码会尝试各种可能的密码组合，直到正确的密码被找到。
Excel表格密码保护的解除方法
Excel表格密码保护的解除方法表格受密码保护时，我们修改数据Excel弹出“您试图更改的单元格或图表受保护，因而是只读的。
若要修改受保护单元格或图表，请先使用‘撤消工作表保护’命令(在‘审阅’选项卡的‘更改’组中)来取消保护。
可能会提示您输入密码。
这时候我们可以用VBA宏代码破解法来破解表格保护密码：第一步：打开该文件，先解除默认的“宏禁用”状态，方法是点击工具栏下的“选项”状态按钮，打开“Microsoft Office安全选项”窗口，选择其中的“启用此内容”，“确定”。
再切换到“视图”选项卡，点击“宏”→“录制宏”，出现“录制新宏”窗口，在“宏名”定义一个名称为：PasswordBreaker，点击“确定”退出；第二步：再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“编辑”，打开“MicrosoftVisualBasic”编辑器，用如下内容替换右侧窗口中的所有代码：SubPasswordBreaker()DimiAsInteger,jAsInteger,kAsIntegerDimlAsInteger,mAsInteger,nAsIntegerDimi1AsInteger,i2AsInteger,i3AsIntegerDimi4AsInteger,i5AsInteger,i6AsIntegerOnErrorResumeNextFori=65To66:Forj=65To66:Fork=65To66Forl=65To66:Form=65To66:Fori1=65To66Fori2=65To66:Fori3=65To66:Fori4=65To66Fori5=65To66:Fori6=65To66:Forn=32To126(i)&Chr(j)&Chr(k)&_Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&Chr(i3)&_Chr(i4)&Chr(i5)&Chr(i6)&Chr(n)=FalseThenMsgBox"Oneusablepasswordis"&Chr(i)&Chr(j)&_Chr(k)&Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&_Chr(i3)&Chr(i4)&Chr(i5)&Chr(i6)&Chr(n)(1).SelectRange("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)ExitSubEndIfNext:Next:Next:Next:Next:NextNext:Next:Next:Next:Next:NextEndSub第三步：再点击“宏”→“查看宏”，选择“宏名”下的“PasswordBreaker”并点击“执行”，密码就现形了第四步：点击“撤消工作表保护”，然后输入密码即可解除锁定；测试结果，密码破解可用，但是很晕的是破解的密码跟原来的密码有很大的差距，想不明白了，反正能用就好。
3种方法破解工作表密码
3种⽅法破解⼯作表密码⼤家好，今天和⼤家分享“破解Excel⼯作表密码'，⼯作表密码其实很很脆弱，破解很容易，下⾯我讲解3种⽅法⼀、纯技巧破解⽅法:不适合03版本,关闭有⼯作表保护的⼯作簿-->选中⼯作簿-->右击-->重命名-->在后⾯加⼀个.Zip-->确认-->变成压缩⽂件-->双击打开压缩包-->打开xl⽂件夹-->worksheets-->找到加密的⼯作表-->把它拖到桌⾯-->打开拖出来的⼯作表,格式是xml的-->删除<sheetProtection password='CF7A' sheet='1' objects='1' scenarios='1'/>-->保存-->关闭拖出来的⼯作表,格式是xml⽂件夹,⼜把它拖回去-->关闭打开压缩包-->右击压缩包-->重命名-->把.zip删除-->确定-->打开⼯作簿-->呵呵,⼯作表密码没有了,⼤功告成.备注:如果你的电脑⾥的⽂件没有扩展名选进⾏此操作我的电脑-->⼯具-->⽂件夹选项-->查看-->去掉'隐藏已知⽂件类型的扩展名'前⾯的钩⼆、代码破解⽅法：快捷键A1t F11打开vbe编辑器→插⼊菜单→插⼊模块→把下⾯的代码复制过去→然后把光标点到代码⾥→F5运⾏⼀下→⼯作表保护就破解了。
Sub 破解⼯作表密码()For x = 1 To Sheets.CountSheets(x).Protect AllowFiltering:=TrueSheets(x).UnprotectNext xEnd Sub三、完美⼯具箱破解操作⽅法见动画具体操作⽅法：完美⼯具箱【9.7.0版】选项卡→加解密码→⼯作表解密码→多次点取消⼀直到破解。
Excel2020中去掉中文繁体版密码保护的操作方法
Excel2020中去掉中文繁体版密码保护的操作方
法
首先，打开保存有你重要数据的EXCEL表格，点击左上角的【檔案】。
然后，选择左边的【資訊】选项卡，点击右边对应的小锁头【保護活頁簿】。
在下拉菜单里选择如下图示的【以密碼加密】选项。
在弹出的对话框输入你要的密码，点击确定。
然后再次输入并确定。
然后你会看到，在【資訊】选项卡右侧显示【開啟此活頁簿需要密碼】表示设置成功。
然后当我们再次双击打开表格的时候会弹出对话框，要求我们输入密码，密码对了才能打开并浏览。
如果要取消刚刚设置的密码，只要输入密码打开表格后重复1到
4步骤，只不过在第4步的时候密码为空(就是不输入密码)就好了。
如何取消excel密码
如何取消excel密码
设置了密码每次打开时都要录入密码，如果不是重要的文件想省事一点的话可以取消密码。
如何取消excel密码?其实不复杂，当然前提是你要知道密码，如果不知道密码想取消密码那就是破解密码了。
下面小编教你们如何取消excel密码：
先录入密码，确定打开要取消密码的excel文件。
在文件菜单下点击另存为，取消密码的办法其实就是再把文件保存一次，在保存替换原文件或重命名时将密码取消掉。
点击工具选择常规选项
删除密码，点击确定并保存。
提示文件已存在要替换它吗?如果想要覆盖原文件直接点击是就替换掉了。
如果想保留原文件重新存一份，点击否再修改文件名保存为一份新的文件。
工作表密码忘了？一招教你删除EXCEL工作表密码
工作表密码忘了？一招教你删除EXCEL工作表密码
大家好！刚学习到一个新的实用技能-删除EXCEL保护密码，所以迫不及待来跟大家分享。
一、痛点概括1、日常工作中，为了让别人不能随意更改工作表，经常会有设置保护密码的时候，如果工作表太多，自己都会记不住；2、别人下发的工作表，想学习函数公式，或者重新修订，有密码保护，不能修改。
二、步骤演示1、如图，我们的工作表已经保护，无法更改和修订；2、关闭当前工作簿，修改后缀名为.RAR；3、双击修改后的文件-找到Sheet1.xml，我的路径是xl-worksheets-sheet1.xml，大家应该差不多；4、复制或者拖动一份到压缩文件外，右键-选择记事本-打开；5、在打开的记事本中，查找：PROTECTION,并删除包含这一词汇的整句语句；（以这两个符号开头和结尾）6、保存记事本文档，并拖动或者复制到原压缩文件中，替换；7、修改文档为.xlsx格式，打开EXCEL，此时已经可以自由编辑。
注意：2003版不适用、EXCEL打开密码不适用。
EXCEL工作表和VBA密码去除法
EXCEL工作表和VBA密码去除法一、工作表密码破解Public Sub 工作表保护密码破解()Const DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _"作者:Neyo "Const HEADER As String = "工作表保护密码破解"Const VERSION As String = DBLSPACE & "版本Version 1.1.1"Const REPBACK As String = DBLSPACE & ""Const ZHENGLI As String = DBLSPACE & " Neyo 整理"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 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 StringDim ShTag As Boolean, WinTag As Boolean Application.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 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 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, HEADER Exit 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 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 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二、VBA密码破解for Excel2003在空白excel文档vba里面插入模块，运行此模块Option ExplicitConst LANG_ENGLISH As Integer = 9Type CommandLineInfoName As StringValue As StringStartPos As LongEnd TypeSub main()Dim fName As StringfName = Application.GetOpenFilename("Excel文件（xls ; xla）,*.xls;*.xla", , "选择要破解的EXCEL2003包含VBA密码的文件")If fName = "False" Then Exit SubDim fNewName As StringfNewName = MoveProtect(fName)If Len(fNewName) ThenIf MsgBox("转换完成,另存为：" & vbLf & fNewName & vbLf & "要打开吗？", vbQuestion + vbYesNo, "完成") = vbYes Then Workbooks.Open fNewName ElseMsgBox "未发现VBAProject有密码特征字符串", vbInformation, "提示"End IfEnd SubPrivate Function MoveProtect(fName As String) As StringDim myExcelFileData As StringDim myCommandLinesInfo() As CommandLineInfomyExcelFileData = GetFileData(fName)If SearchSpecificCommandInfo(myExcelFileData, myCommandLinesInfo) Then MoveProtect = Write2File(Left(fName, Len(fName) - 4) & "_覆盖VBA密码.xls", CoverData(myExcelFileData, myCommandLinesInfo))End IfEnd FunctionPrivate Function GetFileData(fName As String) As StringDim DAT() As ByteReDim DAT(1 To FileLen(fName))Open fName For Binary As #1Get #1, , DATCloseGetFileData = StrConv(DAT, vbUnicode, LANG_ENGLISH)End FunctionPrivate Function SearchSpecificCommandInfo(Content As String, myCommandLinesInfo() As CommandLineInfo) As BooleanDim i As LongDim objRegEx As Object, m As ObjectDim m0 As String, m0StartPos As LongSet objRegEx = CreateObject("VBScript.RegExp")objRegEx.IgnoreCase = TrueobjRegEx.Pattern = CreateSearchCommandPattern()Set m = objRegEx.Execute(Content)If m.Count Thenm0 = m(0).Valuem0StartPos = m(0).firstindex + 1ReDim myCommandLinesInfo(1 To 4)For i = 1 To 4With myCommandLinesInfo(i).Value = m(0).submatches(i - 1).StartPos = m0StartPos + InStr(1, m0, .Value) - 1End WithNextEnd IfSet m = NothingSet objRegEx = NothingSearchSpecificCommandInfo = m0StartPos > 0End FunctionPrivate Function CreateSearchCommandPattern() As String Dim p(1 To 4) As StringDim myPattern As StringDim i As Integerp(1) = "ID=""{00000000-0000-0000-0000-000000000000}"""p(2) = "CMG"p(3) = "DPB"p(4) = "GC"For i = 1 To 4myPattern = myPattern & "(" & p(i) & IIf(i > 1, "=""[a-z0-9]+""", "") & ")" & vbCrLf & "[\s\S]*?"NextCreateSearchCommandPattern = myPattern & "[Host Extender Info]"End FunctionPrivate Function CoverData(Content As String, myCommandLinesInfo() As CommandLineInfo) As Byte()Dim i As LongDim s As Strings = ContentFor i = LBound(myCommandLinesInfo) To UBound(myCommandLinesInfo) With myCommandLinesInfo(i)Mid(s, .StartPos, Len(.Value)) = CreateFillContent(Len(.Value))End WithNextCoverData = StrConv(s, vbFromUnicode, LANG_ENGLISH)End FunctionPrivate Function CreateFillContent(ContentLen As Long) As StringCreateFillContent = Replace(Space(ContentLen \ 2), " ", vbCrLf) & IIf(ContentLen Mod 2, Chr(32), "")End FunctionPrivate Function Write2File(fName As String, DAT() As Byte) As String If Dir(fName) <> "" Then Kill fNameOpen fName For Binary As #1Put #1, , DATCloseWrite2File = fNameEnd Function。
excel表格密码怎么设置与取消
excel表格密码怎么设置与取消
excel表格密码怎么设置与取消align=“center” text-indent: 0px;”>excel表格密码的设置第一步首先打开你需要加密的Excel表格,打开之后找到文件选项,点击出现下拉框,找到另存为选项,点击工具选项,找到常规选项,点击进入操作界面(如下图)。
第二步需要设置的密码有两个,一个是打开excel文件的时候所需要的密码,一个是修改excel表中的数据所需要的密码,填写之后点击确定,会弹出一个再次确认密码框,再次输入密码即可,至此密码的添加已经完成。
第三步打开刚才加密过的文件,此时我们并不能直接进入文件,需要我们输入密码,输入刚才设置的密码即可,如果你也设置了修改数据密码,接着便会弹出输入修改密码对话框,可以输入密码进入;
align=“center” text-indent: 0px;”>excel表格密码的取消1.首先打开加密的文件,此时就会弹跳出输入密码的窗口;
2.然后输入密码,将文件打开;
3.点击右上角的“文件”;
4.点击“保护工作簿”;
5.选择“用密码进行加密”,然后会弹出窗口;
6.然后就会看到,在弹出的窗口,有密码;
7.然后我们将密码删除,然后点击确定;
8.然后将表格关闭,并保存更改,再次打开时就不需要密码了。
excel工作表保护破解
excel工作表保护破解Excel工作表保护破解。
在日常工作中，我们经常会使用Excel表格来存储和处理数据。
为了保护数据的安全性，我们经常会对Excel工作表进行保护。
但有时候我们会遇到需要修改或编辑被保护的工作表的情况，这就需要我们学会如何破解Excel工作表的保护。
破解Excel工作表保护并不是一件复杂的事情，下面我将向大家介绍几种常用的方法。
第一种方法是通过VBA代码来破解Excel工作表保护。
首先，我们需要按下Alt + F11组合键，打开VBA编辑器。
然后在新建的模块中输入以下代码：Sub UnprotectSheet()。
Dim ws As Worksheet。
For Each ws In ThisWorkbook.Worksheets。
ws.Unprotect Password:="yourpassword"Next ws。
End Sub。
在上面的代码中，yourpassword是你设置的工作表保护密码。
执行完上述代码后，所有工作表的保护都会被解除。
第二种方法是通过在线工具来破解Excel工作表保护。
有一些在线工具可以帮助我们破解Excel工作表的保护，例如LostMyPass、Password-Find等。
我们只需要上传被保护的Excel文件，这些工具就可以帮我们破解保护密码。
第三种方法是通过修改Excel文件的扩展名来破解Excel工作表保护。
我们可以将Excel文件的扩展名修改为.zip，然后解压缩这个压缩文件。
在解压缩后的文件夹中，我们可以找到xl目录，里面包含了workbook.xml和worksheets文件夹。
我们可以用记事本打开workbook.xml文件，找到<workbookProtection>节点，将其删除或者修改为<workbookProtection lockStructure="0" lockWindows="0"/>，然后保存文件。
excel文件密码破解方法
excel文件密码破解方法
要破解Excel文件的密码，有几种方法可以尝试。
以下是一些常用的方法：
1. 使用密码破解软件，有一些专门的密码破解软件可以帮助你破解Excel文件密码。
这些软件通常使用暴力破解或字典攻击等方法来尝试破解密码。
你可以在互联网上找到一些可靠的密码破解软件，但请注意使用合法的目的。
2. 使用VBA宏，如果Excel文件中启用了VBA宏，你可以通过编写一段简单的VBA代码来破解密码。
这种方法需要一定的编程知识，但可以尝试使用一些已有的VBA代码来破解密码。
3. 使用在线密码破解服务，有一些在线服务可以帮助你破解Excel文件密码。
你只需上传文件并等待服务破解密码。
然而，这种方法可能不是很安全，因为你需要将文件上传到第三方服务器。
4. 使用备份文件，如果你有Excel文件的备份副本，并且这个副本没有密码保护，你可以打开备份文件并保存为没有密码保护的新文件。
这种方法适用于你只是丢失了密码的情况。
5. 密码提示，有时候，Excel文件的创建者会设置密码提示。
如果你记得密码提示的内容，你可以尝试使用密码提示来回忆密码。
需要注意的是，破解密码是一项敏感的行为，应该遵守法律和
道德规范。
在尝试破解密码之前，请确保你有合法的权限来打开该
文件，并且尊重他人的隐私。
EXCEL忘记密码怎么办EXCEL工作表怎么清除密码
E X C E L忘记密码怎么办E X C E L工作表怎么清除密码集团标准化办公室：[VV986T-J682P28-JP266L8-68PNN]如何破解EXCEL工作表保护密码1.工具---宏----录制新宏---输入名字如:hh2. 3停止录制(这样得到一个空宏)3. 4工具---宏----宏,选hh,点编辑按钮选择“个人宏工作簿”后按确定，弹出如下“暂停”按钮，点击停止：1.点击“运行”按钮后，弹出“宏”对话框，2.点击运行“!工作保护密码破解”这个宏3.99、运行“!工作保护密码破解”这个宏后，如下图示意就可以解除工作表的密码保护了4.10（这个图，如果工作表中有多组不同密码，每解开一组，就会提示一次，也就说可能会出现几次）5.11工作表保护密码破解(代码）=========请复制以下内容=============Public Sub 工作表保护密码破解()Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine & _ "作者:McCormick JE McGimpsey "Const HEADER As String = "工作表保护密码破解"Const VERSION As String = DBLSPACE & "版本 Version " 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 Boolean= FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag OrNext 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 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 66For 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 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 (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 PWord1PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag OrNext 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 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 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 (MSGPWORDFOUND2, _"$$", PWord1), vbInformation, HEADER'leverage finding Pword by trying on other sheetsFor Each w2 In WorksheetsPWord1Next 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, vbInfo rmation, HEADEREnd Sub。
excel表格忘记密码怎么破解
excel表格忘记密码怎么破解一些有着重要的excel文件，工作表肯定会添加密码，但是有时会忘记密码，这是该如何破解呢?其实设置方法不难，有简单暴力的方法，下面随一起来看看excel表格破解工作表密码的方法，欢迎大家来到学习。
excel表格破解工作表密码的方法打开excel工作表。
然后在Excel表中找到【视图】。
点开【宏】。
然后选择【录制宏】。
接着会弹出一个窗口，点击【确定】。
在此点开【宏】，点击【停止录制】。
然后再点击【宏】，弹出窗口点击【编辑】。
然后点击【模板1】，并清空右边红框里的代码，如下图。
然后把破解代码复制粘贴进入空白处(破解代码将在文章最底部分享给大家)。
然后在打开【查看宏】，点击执行破解代码。
会弹出一个框，是英文的，看不懂没关系，点击确定，解密需要一段时间。
12破解代码: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 & vbNewLineConst 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 wereno passwords on " & _"sheets, or workbook structure or windows." & AUTHORS & VERSIONConst MSGNOPWORDS2 As String = "There was no protection to " & _"workbook structure or windows." & DBLSPACE & _"Proceeding to unprotect sheets." & AUTHORS & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst MSGONLYONE As String = "Only structure /windows " & _"protected with the password that was just found." & _ALLCLEAR & AUTHORS & VERSION & REPBACKDim 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 Integer Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Dim PWord1 As StringDim ShT ag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShT ag = FalseFor Each w1 In WorksheetsShT ag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinT ag ThenMsgBox MSGNOPWORDS2, vbInformation, HEADERElseOn 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 ShT ag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShT ag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not.ShT ag = ShTag Or w1.ProtectContentsNext w1If ShT ag 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, vbInformation, HEADEREnd Sub11。
如何删除Excel工作簿的密码保护
如何删除Excel工作簿的密码保护
打开工作簿，然后单击表编辑区域上方菜单栏上的“文件”。
在“文件”下拉列表选项中，将光标移到“信息”，然后在右侧显示的设置选项中，单击“保护工作簿”下拉箭头。
在列表选项中选择“用密码加密”打开“加密文档”对话框。
在“加密文档”对话框中，删除以前在框中设置的密码，然后单击“确定”删除工作簿的密码。
单击“保存”按钮保存以前的设置。
关闭工作簿后，无需输入密码即可再次打开它。
打开工作簿，然后单击表编辑区域上方菜单栏上的“文件”。
教你破掉Excel工作表密码,10秒都不用,工作簿也可以
教你破掉Excel工作表密码，10秒都不用，工作簿也可以在我们平时工作中，经常会遇到有的Excel工作簿是设有密码的，当我们想修改里面的内容的时候，是没办法修改的，这时候我们可能对这个表格就束手无策了。
尤其有时候比较郁闷的是，这个表格是自己设置的密码，然后想不起来了，这时候就更尴尬了。
比如如下我们对Excel设置了保护密码，可以看到Excel是不允许修改的了。
那遇到这样的情况，我们要怎么做呢？今天就教大家1种方法，教你破解Excel设置的密码~~使用压缩包的方法1、首先我们对设置密码的Excel名称进行重命名，把后缀名的.xlsx，改成RAR。
有的小伙伴讲，我这个怎么看不到后缀名怎么办呢？这时我们只要打开【我的电脑】-【文件夹选项】-【查看】，把里面的【隐藏已知文件类型的扩展名】前面的√取消掉，即可显示了所有文件的后缀名了。
2、直接双击打开这个.rar文件，可以看到如下的图示3、我们找到【xl】文件夹，即上图的第3个文件夹，我们打开它，并找到worksheets文件夹，然后点开，可以看到几个sheet名称。
4、这时确认好，设置密码保护的工作表是哪个，然后双击打开它。
我们上面设置密码的工作表是sheet1，所以我们打开sheet1，可以看到很多字符。
不用管它，我们只需要按Ctrl+F查找，查找内容为：Protect，然后选中包含protect内容的两个符号<>（包含这两个符号）之间的内容，全部点击delete删除即可，如下图所示。
5、删除后，关闭文档，这时会提示我们是否更新，我们选择【是】。
6、更新完成后，关闭压缩包，最后再把文件的后缀名，由.RAR格式更改为.xlsx格式，然后我们再打开工作簿，即可以正常编辑了。
最后在给大家分享下原理：在office 2007及以上版本中，Excel的后缀名变为.xlsx，其本质是一个压缩包，构成Excel的所有源代码都在这个压缩包中，所以我们可以通过将其后缀更改为.rar，以压缩包的形式提取出里面的代码内容，并加以修改。
EXCEL密码破解无需任何工具插件超简单
实用标准文案此方法无需任何工具只需要按照以下步骤操作就可以破解EXCEL密码，方便简单快捷EXCEL密码破解1\打开文件2\工具---宏----录制新宏---输入名字如:aa3\停止录制(这样得到一个空宏)4\工具---宏----宏,选aa,点编辑按钮5\删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧)6\关闭编辑窗口7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!!内容如下：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 passwordsConst DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _Adapted from Bob McCormick base code by & _Norman Harker and JE McGimpseyConst HEADER As String = AllInternalPasswords User MessageConst VERSION As String = DBLSPACE & Version 1.1.1 2003-Apr-04Const REPBACK As String = DBLSPACE & Please report failure & _o the microsoft.public.excel.programming newsgroup.Const ALLCLEAR As String = DBLSPACE & The workbook should & _ow 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 & VERSIONConst MSGNOPWORDS2 As String = There was no protection to & _workbook structure or windows. & DBLSPACE & _Proceeding to unprotect sheets. & AUTHORS & VERSIONConst 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 & VERSIONConst 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 & _ he 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 & _uture use in other workbooks by same person who & _set this password. & DBLSPACE & Now to check and clear & _ other passwords. & AUTHORS & VERSIONConst MSGONLYONE As String = Only structure / windows & _ protected with the password that was just found. & _ ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As WorksheetDim 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 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 ThenMsgBox MSGNOPWORDS2, vbInformation, HEADERElseOn Error Resume NextDo 'dummy do loopFor 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 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) & _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 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 ThenPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _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, vbInformation, HEADEREnd Sub文档．实用标准文案穷举破解EXCEL、WORD文档密码摘要：本文讨论了如何使用VB编程，通过穷举法解除EXCEL文档和WORD文档的密码。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
Loop Until True
On Error GoTo 0
End If
End With
Next w1
End If
Option Explicit
Public Sub AllInternalPasswords()
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
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
'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
If Not ShTag Then
MsgBox "解密完成！"
Exit Sub
End If
MsgBox "解密完成！"
End Sub
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)
Next w1
If Not ShTag And Not WinTag Then
MsgBox "无保护密码。"
Exit Sub
End If
MsgBox "பைடு நூலகம்据密码的复杂程度，解密过程将需要花费不同的时间。按任意键开始解密。"
If 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
MsgBox "找到工作簿保护密码：" & PWord1
Exit Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next: Next: Next
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)
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
.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
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
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 "找到工作表保护密码：" & PWord1
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 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
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