我们经常使用Excel的工作表保护功能，将工作表用密码保护起来，以防别人操作时进行修改，但是这样一来有可能会无法进行一些操作（如输入公式等），时间久了保护的密码也有可能忘记了，这该怎么办呢？只要按照以下步骤操作，Excel工作表保护密码瞬间即破！
1、打开您需要破解保护密码的Excel文件；
2、依次点击菜单栏上的工具---宏----录制新宏，输入宏名字如:aa；
3、停止录制(这样得到一个空宏)；
4、依次点击菜单栏上的工具---宏----宏,选aa,点编辑按钮；
5、删除窗口中的所有字符(只有几个),替换为下面的内容；
从横线下开始复制-----------------------------
OptionExplicit
PublicSubAllInternalPasswords()
'Breaksworksheetandworkbookstructurepasswords.BobMcCormick
'probablyoriginatorofbasecodealgorithmmodifiedforcoverage
'ofworkbookstructure/windowspasswordsandformultiplepasswords
'
'NormanHarkerandJEMcGimpsey27-Dec-2002(Version1.1)
'Modified2003-Apr-04byJEM:Allmsgstoconstants,and
'eliminateoneExitSub(Version1.1.1)
'RevealshashedpasswordsNOToriginalpasswords
ConstDBLSPACEAsString=vbNewLine&vbNewLine
ConstAUTHORSAsString=DBLSPACE&vbNewLine&_
"AdaptedfromBobMcCormickbasecodeby"&_
"NormanHarkerandJEMcGimpsey"
ConstHEADERAsString="AllInternalPasswordsUserMessage"
ConstVERSIONAsString=DBLSPACE&"Version1.1.12003-Apr-04"
ConstREPBACKAsString=DBLSPACE&"Pleasereportfailure"&_
"tothemicrosoft.public.excel.programmingnewsgroup."
ConstALLCLEARAsString=DBLSPACE&"Theworkbookshould"&_
"nowbefreeofallpasswordprotection,somakesureyou:"&_
DBLSPACE&"SAVEITNOW!"&DBLSPACE&"andalso"&_
DBLSPACE&"BACKUP!,BACKUP!!,BACKUP!!!"&_
DBLSPACE&"Also,rememberthatthepasswordwas"&_
"putthereforareason.Don'tstuffupcrucialformulas"&_
"ordata."&DBLSPACE&"Accessanduseofsomedata"&_
"maybeanoffense.Ifindoubt,don't."
ConstMSGNOPWORDS1AsString="Therewerenopasswordson"&_
"sheets,orworkbookstructureorwindows."&AUTHORS&VERSION
ConstMSGNOPWORDS2AsString="Therewasnoprotectionto"&_
"workbookstructureorwindows."&DBLSPACE&_
"Proceedingtounprotectsheets."&AUTHORS&VERSION
ConstMSGTAKETIMEAsString="AfterpressingOKbuttonthis"&_
"willtakesometime."&DBLSPACE&"Amountoftime"&_
"dependsonhowmanydifferentpasswords,the"&_
"passwords,andyourcomputer'sspecification."&DBLSPACE&_
"Justbepatient!Makemeacoffee!"&AUTHORS&VERSION
ConstMSGPWORDFOUND1AsString="YouhadaWorksheet"&_
"StructureorWindowsPasswordset."&DBLSPACE&_
"Thepasswordfoundwas:"&DBLSPACE&"$$"&DBLSPACE&_
"Noteitdownforpotentialfutureuseinotherworkbooksby"&_
"thesamepersonwhosetthispassword."&DBLSPACE&_
"Nowtocheckandclearotherpasswords."&AUTHORS&VERSION
ConstMSGPWORDFOUND2AsString="YouhadaWorksheet"&_
"passwordset."&DBLSPACE&"Thepasswordfoundwas:"&_
DBLSPACE&"$$"&DBLSPACE&"Noteitdownforpotential"&_
"futureuseinotherworkbooksbysamepersonwho"&_
"setthispassword."&DBLSPACE&"Nowtocheckandclear"&_
"otherpasswords."&AUTHORS&VERSION
ConstMSGONLYONEAsString="Onlystructure/windows"&_
"protectedwiththepasswordthatwasjustfound."&_
ALLCLEAR&AUTHORS&VERSION&REPBACK
Dimw1AsWorksheet,w2AsWorksheet
DimiAsInteger,jAsInteger,kAsInteger,lAsInteger
DimmAsInteger,nAsInteger,i1AsInteger,i2AsInteger
Dimi3AsInteger,i4AsInteger,i5AsInteger,i6AsInteger
DimPWord1AsString
DimShTagAsBoolean,WinTagAsBoolean
Application.ScreenUpdating=False
WithActiveWorkbook
WinTag=.ProtectStructureOr.ProtectWindows
EndWith
ShTag=False
ForEachw1InWorksheets
ShTag=ShTagOrw1.ProtectContents
Nextw1
IfNotShTagAndNotWinTagThen
MsgBoxMSGNOPWORDS1,vbInformation,HEADER
ExitSub
EndIf
MsgBoxMSGTAKETIME,vbInformation,HEADER
IfNotWinTagThen
MsgBoxMSGNOPWORDS2,vbInformation,HEADER
Else
OnErrorResumeNext
Do'dummydoloop
Fori=65To66:Forj=65To66:Fork=65To66
Forl=65To66:Form=65To66:Fori1=65To66
Fori2=65To66:Fori3=65To66:Fori4=65To66
Fori5=65To66:Fori6=65To66:Forn=32To126
WithActiveWorkbook
.UnprotectChr(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=FalseAnd_
.ProtectWindows=FalseThen
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)
MsgBoxApplication.Substitute(MSGPWORDFOUND1,_
"$$",PWord1),vbInformation,HEADER
ExitDo'Bypassallfor...nexts
EndIf
EndWith
Next:Next:Next:Next:Next:Next
Next:Next:Next:Next:Next:Next
LoopUntilTrue
OnErrorGoTo0
EndIf
IfWinTagAndNotShTagThen
MsgBoxMSGONLYONE,vbInformation,HEADER
ExitSub
EndIf
OnErrorResumeNext
ForEachw1InWorksheets
'AttemptclearancewithPWord1
w1.UnprotectPWord1
Nextw1
OnErrorGoTo0
ShTag=False
ForEachw1InWorksheets
'ChecksforallclearShTagtriggeredto1ifnot.
ShTag=ShTagOrw1.ProtectContents
Nextw1
IfShTagThen
ForEachw1InWorksheets
Withw1
If.ProtectContentsThen
OnErrorResumeNext
Do'Dummydoloop
Fori=65To66:Forj=65To66:Fork=65To66
Forl=65To66:Form=65To66:Fori1=65To66
Fori2=65To66:Fori3=65To66:Fori4=65To66
Fori5=65To66:Fori6=65To66:Forn=32To126
.UnprotectChr(i)&Chr(j)&Chr(k)&_
Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&Chr(i3)&_
Chr(i4)&Chr(i5)&Chr(i6)&Chr(n)
IfNot.ProtectContentsThen
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)
MsgBoxApplication.Substitute(MSGPWORDFOUND2,_
"$$",PWord1),vbInformation,HEADER
'leveragefindingPwordbytryingonothersheets
ForEachw2InWorksheets
w2.UnprotectPWord1
Nextw2
ExitDo'Bypassallfor...nexts
EndIf
Next:Next:Next:Next:Next:Next
Next:Next:Next:Next:Next:Next
LoopUntilTrue
OnErrorGoTo0
EndIf
EndWith
Nextw1
EndIf
MsgBoxALLCLEAR&AUTHORS&VERSION&REPBACK,vbInformation,HEADER
EndSub
----------------------
复制到横线以上
6、关闭编辑窗口；
7、依次点击菜单栏上的工具---宏-----宏,选AllInternalPasswords,运行,确定两次；
【Excel撤销工作表保护密码图文教程介绍】相关文章：