Excel有密码怎么破解?Excel密码破解方法介绍
办公教程导读
收集整理了【Excel有密码怎么破解?Excel密码破解方法介绍】办公软件教程,小编现在分享给大家,供广大互联网技能从业者学习和参考。文章包含12140字,纯文字阅读大概需要18分钟。
办公教程内容图文
2、在宏名一栏中 输入宏的名字 随意健入即可。
3、输入完宏名后 创建的按钮就亮了 点击创建 我们就可以来到 新的界面了。
4、将编辑框内的Sub knife( )End Sub删除 将下列代码 复制 上去。
01Option Explicit
02Public Sub AllInternalPasswords()
03' Breaks worksheet and workbook structure passwords. Bob McCormick
04' probably originator of base code algorithm modified for coverage
05' of workbook structure / windows passwords and for multiple passwords
06'
07' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
08' Modified 2003-Apr-04 by JEM: All msgs to constants, and
09' eliminate one Exit Sub (Version 1.1.1)
10' Reveals hashed passwords NOT original passwords
11Const DBLSPACE As String = vbNewLine & vbNewLine
12Const AUTHORS As String = DBLSPACE & vbNewLine & _
13"Adapted from Bob McCormick base code by" & _
14"Norman Harker and JE McGimpsey"
15Const HEADER As String = "AllInternalPasswords User Message"
16Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
17Const REPBACK As String = DBLSPACE & "Please report failure " & _
18"to the microsoft.public.excel.programming newsgroup."
19Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
20"now be free of all password protection, so make sure you:" & _
21DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
22DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
23DBLSPACE & "Also, remember that the password was " & _
24"put there for a reason. Don't stuff up crucial formulas " & _
25"or data." & DBLSPACE & "Access and use of some data " & _
26"may be an offense. If in doubt, don't."
27Const MSGNOPWORDS1 As String = "There were no passwords on " & _
28"sheets, or workbook structure or windows." & AUTHORS & VERSION
29Const MSGNOPWORDS2 As String = "There was no protection to " & _
30"workbook structure or windows." & DBLSPACE & _
31"Proceeding to unprotect sheets." & AUTHORS & VERSION
32Const MSGTAKETIME As String = "After pressing OK button this " & _
33"will take some time." & DBLSPACE & "Amount of time " & _
34"depends on how many different passwords, the " & _
35"passwords, and your computer's specification." & DBLSPACE & _
36"Just be patient! Make me a coffee!" & AUTHORS & VERSION
37Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
38"Structure or Windows Password set." & DBLSPACE & _
39"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
40"Note it down for potential future use in other workbooks by " & _
41"the same person who set this password." & DBLSPACE & _
42"Now to check and clear other passwords." & AUTHORS & VERSION
43Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
44"password set." & DBLSPACE & "The password found was: " & _
45DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
46"future use in other workbooks by same person who " & _
47"set this password." & DBLSPACE & "Now to check and clear " & _
48"other passwords." & AUTHORS & VERSION
49Const MSGONLYONE As String = "Only structure / windows " & _
50"protected with the password that was just found." & _
51ALLCLEAR & AUTHORS & VERSION & REPBACK
52Dim w1 As Worksheet, w2 As Worksheet
53Dim i As Integer, j As Integer, k As Integer, l As Integer
54Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
55Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
56Dim PWord1 As String
57Dim ShTag As Boolean, WinTag As Boolean
58Application.ScreenUpdating = False
59With ActiveWorkbook
60WinTag = .ProtectStructure Or .ProtectWindows
61End With
62ShTag = False
63For Each w1 In Worksheets
64ShTag = ShTag Or w1.ProtectContents
65Next w1
66If Not ShTag And Not WinTag Then
67MsgBox MSGNOPWORDS1, vbInformation, HEADER
68Exit Sub
69End If
70MsgBox MSGTAKETIME, vbInformation, HEADER
71If Not WinTag Then
72MsgBox MSGNOPWORDS2, vbInformation, HEADER
73Else
74On Error Resume Next
75Do 'dummy do loop
76For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
77For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
78For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
79For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
80With ActiveWorkbook
81.Unprotect Chr(i) & Chr(j) & Chr(k) & _
82Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
83Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
84If .ProtectStructure = False And _
85.ProtectWindows = False Then
86PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
87Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
88Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
89MsgBox Application.Substitute(MSGPWORDFOUND1, _
90"$$", PWord1), vbInformation, HEADER
91Exit Do 'Bypass all for…nexts
92End If
93End With
94Next: Next: Next: Next: Next: Next
95Next: Next: Next: Next: Next: Next
96Loop Until True
97On Error GoTo 0
98End If
99If WinTag And Not ShTag Then
100MsgBox MSGONLYONE, vbInformation, HEADER
101Exit Sub
102End If
103On Error Resume Next
104For Each w1 In Worksheets
105'Attempt clearance with PWord1
106w1.Unprotect PWord1
107Next w1
108On Error GoTo 0
109ShTag = False
110For Each w1 In Worksheets
111'Checks for all clear ShTag triggered to 1 if not.
112ShTag = ShTag Or w1.ProtectContents
113Next w1
114If ShTag Then
115For Each w1 In Worksheets
116With w1
117If .ProtectContents Then
118On Error Resume Next
119Do 'Dummy do loop
120For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
121For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
122For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
123For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
124.Unprotect Chr(i) & Chr(j) & Chr(k) & _
125Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
126Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
127If Not .ProtectContents Then
128PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
129Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
130Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
131MsgBox Application.Substitute(MSGPWORDFOUND2, _
132"$$", PWord1), vbInformation, HEADER
133'leverage finding Pword by trying on other sheets
134For Each w2 In Worksheets
135w2.Unprotect PWord1
136Next w2
137Exit Do 'Bypass all for…nexts
138End If
139Next: Next: Next: Next: Next: Next
140Next: Next: Next: Next: Next: Next
141Loop Until True
142On Error GoTo 0
143End If
144End With
145Next w1
146End If
147MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
148End Sub
复制代码
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
欢迎分享转载→ https://www.word12345.com/excel/50338.html
上一篇:Excel把月份变成季度的函数怎么用?
下一篇:Excel怎么冻结窗口?Excel冻结首行和首列的方法
相关文章
Excel工作表密码忘记了怎么办 2021-12-26
excel表格如何合计自动计算 2022-04-08
excel如何分类汇总 2022-04-07
办公教程总结
以上是为您收集整理的【Excel有密码怎么破解?Excel密码破解方法介绍】办公软件教程的全部内容,希望文章能够帮你了解办公软件教程Excel有密码怎么破解?Excel密码破解方法介绍。
如果觉得办公软件教程内容还不错,欢迎将网站推荐给好友。