《取消EXCEL密码的宏代码(DOC 6页)》由会员分享，可在线阅读，更多相关《取消EXCEL密码的宏代码(DOC 6页)（6页珍藏版）》请在金锄头文库上搜索。
1、For personal use only in study and research; not for commercial use取消EXCEL密码的宏代码2010-02-02 09:14 星期二 .方法:1打开文件2工具-宏-录制新宏-输入名字如:aa3停止录制(这样得到一个空宏)4工具-宏-宏,选aa,点编辑按钮5删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧)6关闭编辑窗口7工具-宏-宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!内容如下：Public Sub AllInternalPasswords() Break
2、s 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 constant
3、s, 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 = AllInternal
4、Passwords User MessageConst VERSION As String = DBLSPACE & Version 1.1.1 2003-Apr-04Const 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, s
5、o 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. Dont stuff up crucial formulas & _or data. & DBLSPACE & Access and use of some data & _may be an offense. If in doub
6、t, dont.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 MSGTAKE
7、TIME 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 computers specification. & DBLSPACE & _Just be patient! Make me a coffee! & AUTHORS & VERSIONConst MSGPWORDFOUND1 As String = You
8、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 & VERSIONCons
9、t 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 &
10、 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 A
11、s 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.Protec
12、tContentsNext 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 66For
13、 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
14、(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 I
15、fEnd 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 WorksheetsAttempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In WorksheetsChecks for all clear ShTag triggered to 1 if n
