如何解开excel密码的教程
时间:2022-08-20 08:07:31
在Excel中经常需要用到密码保护进行保护重要数据,当Excel密码忘记的时候,我们就需要用点技巧把密码给解开。接下来是小编为大家带来的如何解开excel密码的教程,希望对你有用。
如何解开excel密码的教程:
解密步骤1:首先打开EXCEL,选择视图,宏,录制新宏,新建一个宏,可以随便取个名字。
解密步骤2:先生成一个空的宏
解密步骤3:编辑这个宏,选中刚新建的宏后点击编辑按钮
解密步骤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
解密步骤5:关闭掉编辑窗口
解密步骤6:在宏里选中AllInternalPasswords这个编辑好的宏,执行,并且确定数次,就OK了。
![](/images/zang.png)
![](/images/jiucuo.png)
猜你喜欢
Office2019软件安装包及安装教程
![](https://img.aspxhome.com/file/2023/7/16807_0s.jpg)
excel表格热乎取消科学计数法
word2007链接对象和嵌入对象
![](https://img.aspxhome.com/file/2023/8/19838_0s.jpg)
Win10以太网没有有效的IP配置怎么修复?Win10以太网没有有效的IP配置修复方法
![](https://img.aspxhome.com/file/2023/9/52799_0s.png)
Word文字太挤了怎么调?微软Word怎么设置文字间距?
![](https://img.aspxhome.com/file/2023/7/31247_0s.png)
Word2003文章中怎么添加删除线?
![](https://img.aspxhome.com/file/2023/4/30734_0s.jpg)
在excel表格中如何使用定位填充空值?
![](https://img.aspxhome.com/file/2023/4/41144_0s.jpg)
word如何删除文档的属性和个人信息?
![](https://img.aspxhome.com/file/2023/5/23425_0s.png)
Word文档双面打印第二页是反的怎么设置?
![](https://img.aspxhome.com/file/2023/3/31303_0s.png)
excel身份证号码统计易出现的错误
![](https://img.aspxhome.com/file/2023/7/a142277_0s.gif)
造成快捷键无法正常使用
如何在Excel中设置三级下拉菜单和高端多级下拉选项!
![](https://img.aspxhome.com/file/2023/3/a143253_0s.gif)
Excel怎样设置虚线表格
![](https://img.aspxhome.com/file/2023/1/38121_0s.png)
excel表格内数字怎么设置变大写
怎样设计word背景图片
下拉菜单:王琦玩Excel的第十一招
![](https://img.aspxhome.com/file/2023/1/a143101_0s.jpg)
有关Word十则经典的小技巧
Win10 10秒开机要怎么设置?Win10 10秒开机设置方法分享
![](https://img.aspxhome.com/file/2023/7/52297_0s.png)
小明工具箱怎么使用 小明工具箱使用方法分享
![](https://img.aspxhome.com/file/2023/2/39892_0s.jpg)
如何在Excel中判断数字奇偶性
![](https://img.aspxhome.com/file/2023/1/37741_0s.png)