注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

公卫人

博学而笃志 切问而近思

 
 
 

日志

 
 

撤销EXCEL保护  

2017-12-27 23:23:51|  分类: 电脑与手机技术 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
  1. 1. 视图—宏—录制新宏—输入宏名如:aa(aa是可随意输入)

    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略
  2. 停止录制,这样得到一个空宏

    EXCEL工作表保护密码忘记,撤销保护攻略
  3. 同样视图—宏—查看宏—选aa(aa为之前新建的宏)—点击编辑按钮

    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略
















  4. 删除窗口中的所有字符,复制下面的内容粘贴。一个字母、标点符号都不能少。

    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 & _

    "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 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

    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略
  5. 关闭编辑窗口

  6. 视图—宏—查看宏,选AllInternalPasswords,点击执行,确定两次,等2分钟,再确定。密码撤销完毕。

    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略
    EXCEL工作表保护密码忘记,撤销保护攻略

  评论这张
 
阅读(59)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018