VBA清除Excel密码保护,2003/2007/2010均适用
来源:互联网 发布:淘宝可以用什么支付 编辑:程序博客网 时间:2024/04/30 22:26
Sub Macro1()'' Breaks worksheet and workbook structure passwords. Jason S' probably originator of base code algorithm modified for coverage' of workbook structure / windows passwords and for multiple passwords' Jason S http://jsbi.blogspot.com' Reveals hashed passwords NOT original passwordsConst DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & "Adapted from Bob McCormick base code by" & "Jason S http://jsbi.blogspot.com"Const HEADER As String = "AllInternalPasswords User Message"Const VERSION As String = DBLSPACE & "Version 1.0 8 Sep 2008"Const REPBACK As String = DBLSPACE & "Please report failure to jasonblr@gmail.com "Const ALLCLEAR As String = DBLSPACE & "The workbook should be cleared"Const MSGNOPWORDS1 As String = "There were no passwords on " & AUTHORS & VERSIONConst MSGNOPWORDS2 As String = "There was no protection to " & "workbook structure or windows." & DBLSPACEConst MSGTAKETIME As String = "After pressing OK button this " & "will take some time." & DBLSPACE & "Amount of time " & "depends on how many different passwords, the "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 & 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 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, 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 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, vbInformation, HEADER'End Sub
1 0
- VBA清除Excel密码保护,2003/2007/2010均适用
- 用VBA宏代码破解Excel密码保护
- VBA 如何设置密码保护
- 如何密码保护的Microsoft Office Excel 2003
- Office EXCEL 2010如何取消宏密码保护
- Pro Excel 2007 VBA
- Excel 2007及其VBA
- 破解Excel 密码保护
- 解除Excel密码保护大全
- 破解excel密码保护
- VBA如何清除excel单元格的内容和格式?
- Excel VBA 2003和 Excel VBA 2007不兼容的一个例子: 文件搜索
- 轻松破解Microsoft excel 2007 密码保护图文教程
- Excel应用-使用VBA自动绘制所有适用类型的Excel图表(代码及效果图)
- Excel 2003 VBA编程参考
- excel 2003 VBA编程入门教程
- VBA Excel 2007 画饼图
- Excel 2010 中的 VBA 入门
- android 手机一直进安全模式 解决方法
- Git历险记(三)
- 黑马程序员_网络编程
- Java:重写equals()和hashCode()
- 为什么是Createthread后要CloseHandle
- VBA清除Excel密码保护,2003/2007/2010均适用
- C\C++小知识:C\C++中#define和inline的区别
- Path Sum--路径和(重)
- Java 中 再一次看单例模式
- ios返回当前时间,精确到毫秒。
- 黑马程序员_java中IO流的操作规律
- C++调用lua函数的一种通用办法
- servlet、genericservlet、httpservlet之间的区别
- Android中Activity、Service和线程之间的通信