EXCEL工作表保护密码忘记撤销保护攻略.docx

EXCEL工作表保护密码忘记撤销保护攻略.docx

《EXCEL工作表保护密码忘记撤销保护攻略.docx》由会员分享，可在线阅读，更多相关《EXCEL工作表保护密码忘记撤销保护攻略.docx（11页珍藏版）》请在冰豆网上搜索。

EXCEL工作表保护密码忘记撤销保护攻略

EXCEL工作表保护密码忘记-撤销保护攻略

EXCEL工作表保护密码忘记,撤销保护攻略

首次忘记密码撤销保护;如图所示：

视图—宏—录制新宏—输入宏名如:

abc（abc是可随意输入）

删除窗口中的所有字符，复制下面的内容粘贴。

一个字母、标点符号都不能少。

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

关闭编辑窗口

视图—宏—查看宏,选AllInternalPasswords，点击执行，确定两次，等2分钟，再确定。

密码撤销完毕。

END

注意事项

注意复制的内容不能少。

程序编码来源网络，经验操作步骤来源于实战操作。