53°

Excel解除'工作表保护密码',并复原密码设定

前提要求

  1. Office 2003(也就是老版的.xls文件)
  2. 用到宏操作
  3. 可以解除【审阅->保护工作表】的密码保护,其他的密码保护不能处理。

解决方案

  1. 打开需解除保护密码的Excel文件(.xls);
  2. 从菜单栏里找到并打开【录制宏】;
  3. 点击【停止录制】(这样得到一个空宏);
  4. 点击【宏】,找到刚刚录制的宏,点击编辑;
  5. 删除窗口中的所有代码,替换为下面的内容;
    如果菜单没有上述描述的按钮,可以在【文件->选项->自定义功能区】找
  6. Ctrl+S保存关闭编辑窗口;
  7. 点击【宏】,找到刚刚录制的宏,点击执行,按照提示信息操作;
    等会会弹窗提示

    这时密码已经被清除掉了,你就可以随意修改了呀,如果想恢复原来的密码状态,重新点击【审阅->保护工作表】把弹窗中找到的密码原封不动的拷贝进去,并保存,这样原来的密码也可以用,这个密码也可以用
    直接选中窗口按Ctrl+C就能拷贝窗口的全部文字,可以先粘贴到文本编辑器里再取获得的密码

核心宏代码

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 & _ "改编自Bob McCormick的代码。" Const HEADER As String = "重置密码" Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" Const REPBACK As String = DBLSPACE & "感谢使用!" Const ALLCLEAR As String = DBLSPACE & "工作簿现在应该没有任何密码保护,因此请确保:" & _ DBLSPACE & "立即保存!" & DBLSPACE & "并且" & _ DBLSPACE & "备份!, 备份!!, 备份!!!" Const MSGNOPWORDS1 As String = "工作表、工作簿结构或窗口上没有密码。" & AUTHORS & VERSION Const MSGNOPWORDS2 As String = "对工作簿结构或窗口没有保护" & _ "。" & DBLSPACE & _ "继续取消工作表保护。" & AUTHORS & VERSION Const MSGTAKETIME As String = "按下OK按钮后,会需要花费一些时间" & _ "。" & DBLSPACE & "这个时间的长短取决于密码的难度和电脑的性能" & _ "。" & DBLSPACE & _ "请耐心等待,或者先去喝杯茶!" & AUTHORS & VERSION Const MSGPWORDFOUND1 As String = "您设置了工作表结构或Windows密码" & _ "。" & DBLSPACE & _ "找到的密码是:" & DBLSPACE & "$$" & DBLSPACE & _ "请记下来,以备将来由设置此密码" & _ "的同一个人在其他工作簿中使用" & DBLSPACE & _ "现在检查并清除其他密码" & AUTHORS & VERSION Const MSGPWORDFOUND2 As String = "您设置了工作表密码" & _ "。" & DBLSPACE & "找到的密码是:" & _ DBLSPACE & "$$" & DBLSPACE & "请记下来,以备将来由设置此密码" & _ "的同一个人在其他工作簿中使用" & _ "。" & DBLSPACE & "现在检查并清除其他密码" & _ "。" & AUTHORS & VERSION Const MSGONLYONE As String = "只有使用刚找到的密码保护的结构/窗口。" & _ 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

本文转载自博客园,原文链接:https://www.cnblogs.com/MrZhou5/p/12134268.html

全部评论: 0

    我有话说: