如何撤销有密码的工作表保护 本文简介：
【如何撤销有密码的工作表保护】EXCEL工作表编辑资料，设置了工作表保护后，不能对表格进行插入删除操作。如果没有密码，很简单:工具-选项—工作表保护——撤消工作表保护就可以了。如果忘记密码，如下操作：1\打开文件2\工具---宏----录制新宏---输入名字如:a3\停止录制(这样得到一个空宏)4\
如何撤销有密码的工作表保护 本文内容：
【如何撤销有密码的工作表保护
】
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
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
6\关闭编辑窗口
7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟(确实有这么长时间),再确定.
OK,没有密码了!!
如何撤销有密码的工作表保护 本文关键词：撤销，密码，保护，工作
如何撤销有密码的工作表保护 来源：网络整理
免责声明：本文仅限学习分享，如产生版权问题，请联系我们及时删除。
《
如何撤销有密码的工作表保护》由：
76范文网互联网用户整理提供；
链接地址：http://www.yuan0.cn/a/82017.html
转载请保留,谢谢!
