EXCEL工作表保护密码破解 宏撤销保护图文教程(doc)_海文库(免费下载百度文库在线原版)
亲，欢迎来海文库下载文档资料！最新推出：
| 账号登录：
EXCEL工作表保护密码破解 宏撤销保护图文教程查看: 228|回复: 17
自己录制的一段清除操作宏运行正常，但是保护后不能运行，请高手指教问题出在了哪里
[size=14.789px]各位高手：
[size=14.789px]我自己录制了一段清除操作宏，并制定了按钮【清除已录】，运行正常，但是当工作表保护后
[size=14.789px]按钮不能运行，提示错误1004， 请高手指教，在保护状态下按钮如何能正常运行。谢谢
[size=14.789px]代码如下：
[size=14.789px]Sub 清除已录17()
[size=14.789px]'
[size=14.789px]' 清除已录17 宏
[size=14.789px]'
[size=14.789px]'
[size=14.789px]& & Range(&E4:E44&).Select
[size=14.789px]& & Selection.ClearContents
[size=14.789px]& & ActiveWindow.SmallScroll Down:=-30
[size=14.789px]& & ActiveSheet.Range(&$E$3:$E$45&).AutoFilter Field:=1
[size=14.789px]& & Range(&E4&).Select
[size=14.789px]End Sub
[size=14.789px]提示：&&ActiveSheet.Range(&$E$3:$E$45&).AutoFilter Field:=1 出错。
请高手帮助修改下，谢谢
(299.25 KB, 下载次数: 0)
22:57 上传
22:57 上传
点击文件名下载附件
19.43 KB, 下载次数: 0
本帖最后由 france723 于
23:13 编辑
既然保护出错，那么就再执行这个宏之前加一句解除保护，然后宏结束，再加一句开启保护。
Sheets(&工作表名称&).Unprotect& & '解除保护
'你的代码
Sheets(&工作表名称&).Protect UserInterfaceOnly:=True& & '开启保护
End Sub复制代码
Wb.Sheets(&XX&).Protect Password:=&&, UserInterfaceOnly:=True
& && && && && && && && && && && && && && && && && && && && && && && &' 如果为 True，则保护工作表后，可以用宏操作
既然保护出错，那么就再执行这个宏之前加一句解除保护，然后宏结束，再加一句开启保护。
非常感谢您的帮助，不知是我代码修改的问题还是什么别的原因：代码
Sub 清除已录17()
' 清除已录17 宏
& & Sheets(&工作表名称&).Unprotect& & '解除保护
& & Range(&E4:E44&).Select
& & Selection.ClearContents
& & ActiveWindow.SmallScroll Down:=-30
& & ActiveSheet.Range(&$E$3:$E$45&).AutoFilter Field:=1
& & Range(&E4&).Select
Sheets(&工作表名称&).Protect UserInterfaceOnly:=True& & '开启保护
(141.62 KB, 下载次数: 0)
23:25 上传
非常感谢您的帮助，不知是我代码修改的问题还是什么别的原因：代码
Sub 清除已录17()
你的工作表格叫什么，自己修改名字。比如你的工作表叫 Sheet1 . 代码就是Sheets(&Sheet1&).Unprotect&&
懂了吗？要理解代码。
Wb.Sheets(&XX&).Protect Password:=&&, UserInterfaceOnly:=True
& && && && && && && && && && && && & ...
感谢帮助，我是初学，Wb.Sheets(&XX&).Protect Password:=&&, UserInterfaceOnly:=True&&代码加入后运行没有成功。可能是我加入的位置不对等原因。
感谢帮助，我是初学，Wb.Sheets(&XX&).Protect Password:=&&, UserInterfaceOnly:=True&&代码加入后运行 ...
这是教你如何锁定个别单元格的
非常感谢您的帮助，不知是我代码修改的问题还是什么别的原因：代码
Sub 清除已录17()
Sheets(&工作表名称&).Unprotect& & '解除保护
Sheets(&工作表名称&).Protect UserInterfaceOnly:=True& & '开启保护
要根据你实际表格中的名称替换 掉红字
Sheets(&工作表名称&).Unprotect& & '解除保护
Sheets(&工作表名称&).Protect UserInterfaceOnly:=Tru ...
白天没空没有来，感谢您的帮助，解除保护和开启保护表格名称替换后，可以进行删除了。经测试存在问题为：E3单元格为筛选单元格，第一次运行没有任何问题，但第二次及以后运行时E3单元格被自动锁定了，无法进行筛选操作，按钮删除没问题。不知什么原因。谢谢
重新上附件 , 不知道你现在代码是什么样的
Powered by宏命令1分钟破解Excel保护~
现在 许多 网上下载的Excel表格 都设置了保护 不能选中 不能复制 为了保护知识产权~ 还有就是 一些学校 上机考试用的Excel
表格 也设置了保护 其实保护的后面就是答案。
&& 话不多说，进入正题
1.进入Excel 用快捷命令Alt+F8 打开宏命令 窗口
2.在宏名一栏中 输入宏的名字&
随意健入即可
3.输入完宏名后 创建的按钮就亮了 点击创建
我们就可以来到 新的界面了
4.将编辑框内的Sub knife(& )End Sub删除 将下列代码 复制 上去
Option Explicit
Public Sub AllInternalPasswords()
' Breaks worksheet and workbook structure passwords. Bob
' probably originator of base code algorithm modified for
' of workbook structure / windows passwords and for multiple
' 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 &
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
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
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
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 &
Const MSGONLYONE As String = "Only structure / windows "
"protected with the password that was just found."
ALLCLEAR & AUTHORS & VERSION
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
Dim PWord1 As String
Dim ShTag As Boolean, WinTag As Boolean
Application.ScreenUpdating = False
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
If Not ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation, HEADER
MsgBox MSGTAKETIME, vbInformation, HEADER
If Not WinTag Then
MsgBox MSGNOPWORDS2, vbInformation, HEADER
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)
MsgBox Application.Substitute(MSGPWORDFOUND1, _
"$$", PWord1), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
If WinTag And Not ShTag Then
MsgBox MSGONLYONE, vbInformation, HEADER
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
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
If ShTag Then
For Each w1 In Worksheets
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)
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)
MsgBox Application.Substitute(MSGPWORDFOUND2, _
"$$", PWord1), vbInformation, HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Exit Do 'Bypass all for...nexts
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
MsgBox ALLCLEAR & AUTHORS & VERSION
& REPBACK, vbInformation, HEADER
5.关闭 宏窗口 回到Excel下 按ALT+F8 重新打开 宏命令窗口
6.你会发现 你前面输入的宏名 变成了AllInternalPasswords 点击执行 会出现如下对话框 点确定
7. 一直点 确定 知道不在 出现对话框为止
8.等待 一段之间之后 系统会 再次跳出对话框 再点确定 保护就破解成功了
不是太难吧
。。。不要拿去作弊哦~&&&&&&
THE END。。。
已投稿到：
以上网友发言只代表其个人观点，不代表新浪网的观点或立场。