如何撤销有密码的工作表保护

撤销密码工作表保护
EXCEL工作表编辑资料设置工作表保护表格进行插入删操作果没密码简单工具选项—工作表保护——撤消工作表保护 果忘记密码操作： 1\开文件
2\工具宏录制新宏输入名字a
3\停止录制(样空宏)
4\工具宏宏选a点编辑钮
5\删窗口中字符()换面容(复制)
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 27Dec2002 (Version 11)
' Modified 2003Apr04 by JEM All msgs to constants and
' eliminate one Exit Sub (Version 111)
' 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 111 2003Apr04
Const REPBACK As String DBLSPACE & Please report failure & _
to the microsoftpublicexcelprogramming 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
ApplicationScreenUpdating False
With ActiveWorkbook
WinTag ProtectStructure Or ProtectWindows
End With
ShTag False
For Each w1 In Worksheets
ShTag ShTag Or w1ProtectContents
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 ApplicationSubstitute(MSGPWORDFOUND1 _
PWord1) vbInformation HEADER
Exit Do 'Bypass all fornexts
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
w1Unprotect 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 w1ProtectContents
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 ApplicationSubstitute(MSGPWORDFOUND2 _
PWord1) vbInformation HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2Unprotect PWord1
Next w2
Exit Do 'Bypass all fornexts
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
6\关闭编辑窗口
7\工具宏宏选AllInternalPasswords运行确定两次等2分钟(确实长时间)确定
OK没密码

文档香网(httpswwwxiangdangnet)户传

《香当网》用户分享的内容，不代表《香当网》观点或立场，请自行判断内容的真实性和可靠性！
该内容是文档的文本内容，更好的格式请下载文档