Excel 工作表，单元格破解密码宏
2024-05-13 16:36:55
1
'1、 打开要破解的EXCEL文件|
2
3'2、 工具---宏----录制新宏---输入名字如:aa -----关闭
4
5'3、 工具---宏----停止录制(这样得到一个空宏)
6
7'4、 工具---宏----宏,选aa,点 编辑 按钮
8
9'5、 删除窗口中的所有字符(只有几个),替换为下面解压后文件中内容
10
11'Excel密码破解.rar
12
13'6、关闭编辑窗口
14
15'7、工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!
16
17
18
19
20
21
22Option Explicit
23
24Public Sub AllInternalPasswords()
25' Breaks worksheet and workbook structure passwords. Bob McCormick
26' probably originator of base code algorithm modified for coverage
27' of workbook structure / windows passwords and for multiple passwords
28'
29' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
30' Modified 2003-Apr-04 by JEM: All msgs to constants, and
31' eliminate one Exit Sub (Version 1.1.1)
32' Reveals hashed passwords NOT original passwords
33Const DBLSPACE As String = vbNewLine & vbNewLine
34Const AUTHORS As String = DBLSPACE & vbNewLine & _
35"Adapted from Bob McCormick base code by" & _
36"Norman Harker and JE McGimpsey"
37Const HEADER As String = "AllInternalPasswords User Message"
38Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
39Const REPBACK As String = DBLSPACE & "Please report failure " & _
40"to the microsoft.public.excel.programming newsgroup."
41Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
42"now be free of all password protection, so make sure you:" & _
43DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
44DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
45DBLSPACE & "Also, remember that the password was " & _
46"put there for a reason. Don't stuff up crucial formulas " & _
47"or data." & DBLSPACE & "Access and use of some data " & _
48"may be an offense. If in doubt, don't."
49Const MSGNOPWORDS1 As String = "There were no passwords on " & _
50"sheets, or workbook structure or windows." & AUTHORS & VERSION
51Const MSGNOPWORDS2 As String = "There was no protection to " & _
52"workbook structure or windows." & DBLSPACE & _
53"Proceeding to unprotect sheets." & AUTHORS & VERSION
54Const MSGTAKETIME As String = "After pressing OK button this " & _
55"will take some time." & DBLSPACE & "Amount of time " & _
56"depends on how many different passwords, the " & _
57"passwords, and your computer's specification." & DBLSPACE & _
58"Just be patient! Make me a coffee!" & AUTHORS & VERSION
59Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
60"Structure or Windows Password set." & DBLSPACE & _
61"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
62"Note it down for potential future use in other workbooks by " & _
63"the same person who set this password." & DBLSPACE & _
64"Now to check and clear other passwords." & AUTHORS & VERSION
65Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
66"password set." & DBLSPACE & "The password found was: " & _
67DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
68"future use in other workbooks by same person who " & _
69"set this password." & DBLSPACE & "Now to check and clear " & _
70"other passwords." & AUTHORS & VERSION
71Const MSGONLYONE As String = "Only structure / windows " & _
72"protected with the password that was just found." & _
73ALLCLEAR & AUTHORS & VERSION & REPBACK
74Dim w1 As Worksheet, w2 As Worksheet
75Dim i As Integer, j As Integer, k As Integer, l As Integer
76Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
77Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
78Dim PWord1 As String
79Dim ShTag As Boolean, WinTag As Boolean
80
81Application.ScreenUpdating = False
82With ActiveWorkbook
83WinTag = .ProtectStructure Or .ProtectWindows
84End With
85ShTag = False
86For Each w1 In Worksheets
87ShTag = ShTag Or w1.ProtectContents
88Next w1
89If Not ShTag And Not WinTag Then
90MsgBox MSGNOPWORDS1, vbInformation, HEADER
91Exit Sub
92End If
93MsgBox MSGTAKETIME, vbInformation, HEADER
94If Not WinTag Then
95MsgBox MSGNOPWORDS2, vbInformation, HEADER
96Else
97On Error Resume Next
98Do 'dummy do loop
99For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
100For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
101For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
102For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
103With ActiveWorkbook
104.Unprotect Chr(i) & Chr(j) & Chr(k) & _
105Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
106Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
107If .ProtectStructure = False And _
108.ProtectWindows = False Then
109PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
110Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
111Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
112MsgBox Application.Substitute(MSGPWORDFOUND1, _
113"$$", PWord1), vbInformation, HEADER
114Exit Do 'Bypass all fornexts
115End If
116End With
117Next: Next: Next: Next: Next: Next
118Next: Next: Next: Next: Next: Next
119Loop Until True
120On Error GoTo 0
121End If
122If WinTag And Not ShTag Then
123MsgBox MSGONLYONE, vbInformation, HEADER
124Exit Sub
125End If
126On Error Resume Next
127For Each w1 In Worksheets
128'Attempt clearance with PWord1
129w1.Unprotect PWord1
130Next w1
131On Error GoTo 0
132ShTag = False
133For Each w1 In Worksheets
134'Checks for all clear ShTag triggered to 1 if not.
135ShTag = ShTag Or w1.ProtectContents
136Next w1
137If ShTag Then
138For Each w1 In Worksheets
139With w1
140If .ProtectContents Then
141On Error Resume Next
142Do 'Dummy do loop
143For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
144For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
145For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
146For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
147.Unprotect Chr(i) & Chr(j) & Chr(k) & _
148Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
149Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
150If Not .ProtectContents Then
151PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
152Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
153Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
154MsgBox Application.Substitute(MSGPWORDFOUND2, _
155"$$", PWord1), vbInformation, HEADER
156'leverage finding Pword by trying on other sheets
157For Each w2 In Worksheets
158w2.Unprotect PWord1
159Next w2
160Exit Do 'Bypass all fornexts
161End If
162Next: Next: Next: Next: Next: Next
163Next: Next: Next: Next: Next: Next
164Loop Until True
165On Error GoTo 0
166End If
167End With
168Next w1
169End If
170MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
171End Sub
'1、 打开要破解的EXCEL文件|2
3
'2、 工具---宏----录制新宏---输入名字如:aa -----关闭4
5
'3、 工具---宏----停止录制(这样得到一个空宏)6
7
'4、 工具---宏----宏,选aa,点 编辑 按钮8
9
'5、 删除窗口中的所有字符(只有几个),替换为下面解压后文件中内容10
11
'Excel密码破解.rar12
13
'6、关闭编辑窗口14
15
'7、工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!16
17
18
19
20
21
22
Option Explicit 23
24
Public Sub AllInternalPasswords() 25
' Breaks worksheet and workbook structure passwords. Bob McCormick 26
' probably originator of base code algorithm modified for coverage 27
' of workbook structure / windows passwords and for multiple passwords 28
' 29
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 30
' Modified 2003-Apr-04 by JEM: All msgs to constants, and 31
' eliminate one Exit Sub (Version 1.1.1) 32
' Reveals hashed passwords NOT original passwords 33
Const DBLSPACE As String = vbNewLine & vbNewLine 34
Const AUTHORS As String = DBLSPACE & vbNewLine & _ 35
"Adapted from Bob McCormick base code by" & _ 36
"Norman Harker and JE McGimpsey" 37
Const HEADER As String = "AllInternalPasswords User Message" 38
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" 39
Const REPBACK As String = DBLSPACE & "Please report failure " & _ 40
"to the microsoft.public.excel.programming newsgroup." 41
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ 42
"now be free of all password protection, so make sure you:" & _ 43
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ 44
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 45
DBLSPACE & "Also, remember that the password was " & _ 46
"put there for a reason. Don't stuff up crucial formulas " & _ 47
"or data." & DBLSPACE & "Access and use of some data " & _ 48
"may be an offense. If in doubt, don't." 49
Const MSGNOPWORDS1 As String = "There were no passwords on " & _ 50
"sheets, or workbook structure or windows." & AUTHORS & VERSION 51
Const MSGNOPWORDS2 As String = "There was no protection to " & _ 52
"workbook structure or windows." & DBLSPACE & _ 53
"Proceeding to unprotect sheets." & AUTHORS & VERSION 54
Const MSGTAKETIME As String = "After pressing OK button this " & _ 55
"will take some time." & DBLSPACE & "Amount of time " & _ 56
"depends on how many different passwords, the " & _ 57
"passwords, and your computer's specification." & DBLSPACE & _ 58
"Just be patient! Make me a coffee!" & AUTHORS & VERSION 59
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ 60
"Structure or Windows Password set." & DBLSPACE & _ 61
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 62
"Note it down for potential future use in other workbooks by " & _ 63
"the same person who set this password." & DBLSPACE & _ 64
"Now to check and clear other passwords." & AUTHORS & VERSION 65
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 66
"password set." & DBLSPACE & "The password found was: " & _ 67
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 68
"future use in other workbooks by same person who " & _ 69
"set this password." & DBLSPACE & "Now to check and clear " & _ 70
"other passwords." & AUTHORS & VERSION 71
Const MSGONLYONE As String = "Only structure / windows " & _ 72
"protected with the password that was just found." & _ 73
ALLCLEAR & AUTHORS & VERSION & REPBACK 74
Dim w1 As Worksheet, w2 As Worksheet 75
Dim i As Integer, j As Integer, k As Integer, l As Integer 76
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer 77
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 78
Dim PWord1 As String 79
Dim ShTag As Boolean, WinTag As Boolean 80
81
Application.ScreenUpdating = False 82
With ActiveWorkbook 83
WinTag = .ProtectStructure Or .ProtectWindows 84
End With 85
ShTag = False 86
For Each w1 In Worksheets 87
ShTag = ShTag Or w1.ProtectContents 88
Next w1 89
If Not ShTag And Not WinTag Then 90
MsgBox MSGNOPWORDS1, vbInformation, HEADER 91
Exit Sub 92
End If 93
MsgBox MSGTAKETIME, vbInformation, HEADER 94
If Not WinTag Then 95
MsgBox MSGNOPWORDS2, vbInformation, HEADER 96
Else 97
On Error Resume Next 98
Do 'dummy do loop 99
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 100
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 101
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 102
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 103
With ActiveWorkbook 104
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 105
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ 106
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 107
If .ProtectStructure = False And _ 108
.ProtectWindows = False Then 109
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 110
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 111
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 112
MsgBox Application.Substitute(MSGPWORDFOUND1, _ 113
"$$", PWord1), vbInformation, HEADER 114
Exit Do 'Bypass all fornexts 115
End If 116
End With 117
Next: Next: Next: Next: Next: Next 118
Next: Next: Next: Next: Next: Next 119
Loop Until True 120
On Error GoTo 0 121
End If 122
If WinTag And Not ShTag Then 123
MsgBox MSGONLYONE, vbInformation, HEADER 124
Exit Sub 125
End If 126
On Error Resume Next 127
For Each w1 In Worksheets 128
'Attempt clearance with PWord1 129
w1.Unprotect PWord1 130
Next w1 131
On Error GoTo 0 132
ShTag = False 133
For Each w1 In Worksheets 134
'Checks for all clear ShTag triggered to 1 if not. 135
ShTag = ShTag Or w1.ProtectContents 136
Next w1 137
If ShTag Then 138
For Each w1 In Worksheets 139
With w1 140
If .ProtectContents Then 141
On Error Resume Next 142
Do 'Dummy do loop 143
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 144
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 145
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 146
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 147
.Unprotect Chr(i) & Chr(j) & Chr(k) & _ 148
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 149
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 150
If Not .ProtectContents Then 151
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 152
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 153
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 154
MsgBox Application.Substitute(MSGPWORDFOUND2, _ 155
"$$", PWord1), vbInformation, HEADER 156
'leverage finding Pword by trying on other sheets 157
For Each w2 In Worksheets 158
w2.Unprotect PWord1 159
Next w2 160
Exit Do 'Bypass all fornexts 161
End If 162
Next: Next: Next: Next: Next: Next 163
Next: Next: Next: Next: Next: Next 164
Loop Until True 165
On Error GoTo 0 166
End If 167
End With 168
Next w1 169
End If 170
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 171
End Sub
转载于:https://www.cnblogs.com/geovindu/archive/2009/11/14/1602917.html
Excel 工作表，单元格破解密码宏相关推荐
- 为Excel工作表单元格命名的两种方法
为单元格起一个名字是一个非常好的习惯,这不仅可以帮助用户记忆,而且可以提高工作效率.用户可以有两种方法为单元格命名.选中要命名的单元格,选择"插 入"菜单中的"名称&qu ...
- 来自工作表单元格的Excel按钮文本
If you have buttons or shapes on an Excel worksheet, you can get their caption text from a workshee ...
- 国产Excel开发组件Spire.XLS【转换】教程（5）：#/将特定工作表单元格转换为图像
本节旨在为开发人员提供详细的解决方案,了解如何通过 C#.VB.NET 中的 .NET Excel 组件 Spire.XLS 将特定的工作表单元格转换为图像.这个 Excel 库帮助我们快速将某些 E ...
- 工作表单元格区域另存为图片
实例需求:工作表中的表格内容(A1:C8)另存为图片. 这个很难吗?确实不难.一定要用VBA吗?不一定呦.先来看看如下操作,在工作表中选中相应的单元格区域,依次点击[开始]选项卡的[复制]下拉按钮-& ...
- Excel工作表密码保护的破解
操作步骤:打开Visual Basic编辑器,单击"插入-->模块",将以下代码粘贴到模块中即可. Sub DelPassword()ActiveSheet.Protect ...
- excel链接隐藏工作表_自动隐藏Excel工作表
excel链接隐藏工作表 When you build a workbook for other people to use, there might be worksheets that can s ...
- c# excel工作表及cell读取
昨天晚上做了一回雷锋,帮朋友写了个程序,把他2天都未整理好的Excel数据,一个小时搞定.大致如下:我朋友是搞质检的,每天都会产生一个excel文件,每个excel文件都有20来个工作表,他要做的事情 ...
- c# excel工作表及cell读取 .
转发至:http://blog.csdn.net/chuangxin/article/details/6085577 昨天晚上做了一回雷锋,帮朋友写了个程序,把他2天都未整理好的Excel数据,一个小 ...
- 计算机设置和美化表格优质课,信息技术教案第三节：Excel工作表的编辑与美化.doc...
信息技术教案第三节:Excel工作表的编辑与美化 信息技术教案第三节:Excel工作表的编辑与美化 教学目标:掌握Excel中工作表增.删重命名,工作表单元格的行列编辑,文字的润色,行高.列宽的改变, ...
最新文章
- Octave中无法使用rgb2gray()函数
- 使用 NuGet 管理我们的程序集 - 预发行版
- 算法学习-莫比乌斯反演
- mysql内置函数，在mysql里面利用str_to_date（）把字符串转换为日期格式
- 国家开放大学计算机应用模块3客观题答案,国家开放大学《计算机应用基础》考试与答案形考任务模块3模块3Excel2010电子表格系统—客观题答案.pdf...
- php7 php5 区别,php7与php5的区别有哪些？
- 这个 80 后 IT 男厉害了！他用北京蜗居的首付在东京海淘了一栋楼！
- Linux基础(十一)--Linux文件查找命令Find详解
- FastAPI + Vue 前后端分离 接口自动化测试工具 apiAutoTestWeb
- 基于SpringBoot+Mybatis+Thymeleaf的信息管理系统
- 关于CCS软件的Graph功能使用详解
- 手把手教你开发-滚动效果号码抽奖（QT）
- 【教学类-07-02】20220330 5以内加减法不重复题 及生成word打印docx纸（方法二）（Python VS）
- nowcoder20619 禁书目录
- ipa签名工具（IPA Resign Tool）在windows和macos系统下对苹果ipa文件一键重签名
- 微软的语音交互“滑铁卢”：Cortana小娜悲惨收场，未来路在何方？
- 如何全链路进行前端性能优化
- mysql 1146错误
- 20210323 美团后台开发实习一面（快驴）
- 行测做的慢，如何提升做题速度?怎么提升正确率？
热门文章
- php分页采集数据,php实现分页调取数据库记录
- tensorflow生成图片标签_Tensorboard高维向量可视化 + 解决标签和图片不显示BUG
- css rem 大屏开发_px/em/rem的区别与应用
- 申报控件检测未通过_详解高企申报未通过原因！
- 浙江省计算机二级c理论题库,浙江省计算机级考试二级《C程序设计》上机考试题库.doc...
- 福建省计算机学会 noip比赛,重磅！福州一三附学生领衔全省前九名！他们将代表福建参加全国比赛！...
- android域账号认证失败,绕过域账户认证失败锁定次数限制的技巧
- python 定时执行 爬虫 模块_浅析python实现scrapy定时执行爬虫
- api与密度转换公式_API重度和密度换算公式
- oracle移动表所在的表空间,ORACLE移动表空间（原）