当前位置:网站首页> 经验杂谈>正文

如何破解EXCEL工作表保护密码忘记密码怎么办,需要技巧

发布于:2019-12-04 19:27:03发问者:天晴问友| 评论:

如何破解EXCEL工作表保护密码忘记密码怎么办

工具/材料

EXCel2007-2016

电脑一台

操作方法

01

新建一个EXCEL工作表,而后点击另存为,讲表格保存为启用宏的工作表

02

一次点击开发工具---录制新宏,在弹出的对话框内修改宏名称而后确定

03

依次点击开发工具----停止录制宏,宏录制完成

04

依次点击开发工具,---宏----在弹出的对话框找到我们刚才录制的宏名称而后进入VBA界面

05

在VBA界面,全选里面的代码,而后删除,讲里面的代码全部删除完

06

代码复制到VBA编辑窗口内
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
点击保存

07

点击开发工具,宏,找到我们刚才录制的宏,点击执行宏

08

而后,在弹出的所有对话框上,都点击确定,都确定,1分钟后,就可以编辑了

好了,以上就是大致内容了,(END)

请不要用于非法用途!

本方法仅适用于2007-2016,2003版本没有开发工具

相关经验+更多
  • Excel工作表保护的口令忘记了怎么办 来学习吧

    Excel工作表保护的口令忘记了怎么办 来学习吧

    如果你想使用一个保护了的工作表,但口令又忘记了,有办法吗?有。选定工作表,选择“编辑”\ “复制”、“粘贴”,将其拷贝到一个新的工作薄中(注意:一定要是新工作簿),

  • bilibili如何下载视频? 详情介绍

    bilibili如何下载视频? 详情介绍

    bilibili现为国内最大的年轻人潮流文化娱乐社区,又被网友称为“B站”。它不但内容丰富, 看视频时没有广告,而它最大的特色是悬浮于视频上方的实时评论功能,爱好者称其为“ 弹

  • 如何种植芒果,来学习吧

    如何种植芒果,来学习吧

    芒果对于很多人来说都不会陌生,新鲜的口感是许多水果达人的最爱,不仅是口感好,而且营养也非常的出众,本次就为大家分享一下芒果的种植方法。 操作方法 01 光照:光照充足的

  • 如何下载bilibili的视频,详情介绍

    如何下载bilibili的视频,详情介绍

    在bilibili中大家可以找到很多好看的视频,当看到喜欢的视频的时候,如何将它们下载下来呢?下面来看看如何下载bilibili的视频? 工具/材料 bilibili 操作方法 01 打开bilibili官网。在bi

  • 如何种芒果,需要技巧

    如何种芒果,需要技巧

    芒果树是最容易从种子开始种的树之一。长出来的芒果大小和味道取决于你的芒果品种,所以一定要选择你吃过的而且好吃的芒果来种。你既可以在花盆里种,让它长成小树苗,也可以

  • 电脑上如何下载bilibili的视频,经验告诉你该这样

    电脑上如何下载bilibili的视频,经验告诉你该这样

    方法一:bilibilijj 01 想要在电脑上下载B站的视频其实很简单,首先打开B站,找到你想要下载的视频。 02 接着在地址栏的bilibili后面加上“jj”这两个字母,注意这两个字母一定要夹在

经验评论

评论列表(条(包括审核中))