Excel2003 找回工作表密码方法

利用宏的方法：

方法一：找回密码

Sub unPsht() '删除工作表密码
Dim i As Byte, j As Byte, k As Byte
Dim l As Byte, m As Byte, n As Byte
Dim i1 As Byte, i2 As Byte, i3 As Byte
Dim i4 As Byte, i5 As Byte, i6 As Byte
On Error Resume Next
If ActiveSheet.ProtectContents = False Then MsgBox "该工作表没有设置密码保护", 32, "提示": Exit Sub
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
ActiveSheet.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 ActiveSheet.ProtectContents = False Then
MsgBox "找到一个可用密码" & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub

方法二：清除密码

Public Sub 工作表保护密码破解()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"作者:McCormick JE McGimpsey "
Const HEADER As String = "工作表保护密码破解"
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1"
Const REPBACK As String = DBLSPACE & ""
Const ZHENGLI As String = DBLSPACE & " hfhzi3—戊冥整理"
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！"
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!"
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "" & DBLSPACE & "如果该文件工作表有不同密码,将搜索下一组密码并修改清除"
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "" & DBLSPACE & "如果该文件工作表有不同密码,将搜索下一组密码并解除"
Const MSGONLYONE As String = "确保为唯一的?"
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
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 & ZHENGLI, vbInformation, HEADER
End Sub

Excel2003 找回工作表密码方法相关推荐

excel打开密码忘记了_excel工作表密码忘了，我不知道怎么办，同事2分钟就把密码删除了...
Hello,大家好,在生活中忘掉密码是一件很常见的事情,但是密码的找回或者重置就不那么容易了,那么当excel工作表的密码被遗忘有没有什么办法将密码删除呢,当然有了,今天跟大家分享一种快速删除exce ...
Excel撤销工作表保护方法(Excel无法调节列宽解决办法)
Excel撤销工作表保护方法前言 1.Excel工作表保护表现 2.忘记密码如何清除Excel的密码保护 1.第一步:录制宏 2.第二步:结束宏 3.第三步:编辑宏脚本 4.运行结果前言在某工作 ...
Excel工作表密码破解
Excel是我们工作中经常要用到的数据处理工具,有时候为了安全会给工作表设置密码,但是时间长了可能会忘记密码,这时连自己都无法修改了,这时我这个方法就很有用了. 打开Excel程序,找到开发工具,打开 ...
关于excel密码工作表密码工作簿密码工程密码
以下代码皆亲测可用代码1: 可清除工作表.工作簿密码,并复制密码到剪切板代码2: 绕过限制,把内容复制到新文件,相当于另存一份无工作簿保护代码3: 可清除工作表密码,并复制密码到剪切板(不能清除 ...
EXCEL VBAProject密码破解工作表密码破解
1.修改.xlsm后缀为.zip 2.使用压缩软件打开,进入xl目录找到vbaProject.bin文件,解压出来 3.使用Hex软件打开vbaProject.bin文件,查找DPB替换成DPx,保存 ...
如何轻松的破解excel 2016工作表密码
如何轻松的破解excel 2016工作表密码请把以下链接破解流程中的脚本写成我给出的代码 http://jingyan.baidu.com/article/3f16e003f807782591c10 ...
瞬间破解Excel工作表密码和保护工作簿密码，不管密码有多复杂
工作表密码:保护单元格不让修改的密码. 工作簿密码:保护工作簿窗口和结构,不让新建窗口.不让修改工作簿结构的密码.修改工作簿结构包含修改工作表名称.插入工作表和删除工作表. 以上两种Excel密码可以 ...
离开当前屏幕的判断方法_EXCEL 一个工作表如何快速拆分多个工作表的方法
下面说下在一个工作簿里把里面的一个工作表依据实际需求的条件内容,快速拆分成多个工作表方法. 1.打开excel文件,现在需要依据地区和国家这个条件,分别单独生成不同的工作表出来,最原始的方法是手动新建 ...
[Python] python 破解Excel密码(还原工作表密码)
Excel 工作表编辑密码位数为12位范围是AAAAAAAAAAA (注意A后面有个空格)至BBBBBBBBBBB~ 拥有194560个组合支持xlsx,支持wps 原理: 在保护工作表或者工作簿 ...

Excel2003 找回工作表密码方法

Excel2003 找回工作表密码方法相关推荐

最新文章

热门文章