excel工作表如何撤销保护Word格式文档下载.docx
《excel工作表如何撤销保护Word格式文档下载.docx》由会员分享,可在线阅读,更多相关《excel工作表如何撤销保护Word格式文档下载.docx(17页珍藏版)》请在冰豆网上搜索。
PublicSubAllInternalPasswords()
'
Breaksworksheetandworkbookstructurepasswords.BobMcCormick
probablyoriginatorofbasecodealgorithmmodifiedforcoverage
ofworkbookstructure/windowspasswordsandformultiplepasswords
NormanHarkerandJEMcGimpsey27-Dec-2019(Version1.1)
Modified2019-Apr-04byJEM:
Allmsgstoconstants,and
eliminateoneExitSub(Version1.1.1)
RevealshashedpasswordsNOToriginalpasswords
ConstDBLSPACEAsString=vbNewLine&
vbNewLine
ConstAUTHORSAsString=DBLSPACE&
vbNewLine&
_
"
AdaptedfromBobMcCormickbasecodeby"
&
NormanHarkerandJEMcGimpsey"
ConstHEADERAsString="
AllInternalPasswordsUserMessage"
ConstVERSIONAsString=DBLSPACE&
Version1.1.12019-Apr-04"
ConstREPBACKAsString=DBLSPACE&
Pleasereportfailure"
tothemicrosoft.public.excel.programmingnewsgroup."
ConstALLCLEARAsString=DBLSPACE&
Theworkbookshould"
nowbefreeofallpasswordprotection,somakesureyou:
"
DBLSPACE&
SAVEITNOW!
andalso"
BACKUP!
BACKUP!
!
Also,rememberthatthepasswordwas"
putthereforareason.Don'
tstuffupcrucialformulas"
ordata."
Accessanduseofsomedata"
maybeanoffense.Ifindoubt,don'
t."
ConstMSGNOPWORDS1AsString="
Therewerenopasswordson"
sheets,orworkbookstructureorwindows."
AUTHORS&
VERSION
ConstMSGNOPWORDS2AsString="
Therewasnoprotectionto"
workbookstructureorwindows."
Proceedingtounprotectsheets."
ConstMSGTAKETIMEAsString="
AfterpressingOKbuttonthis"
willtakesometime."
Amountoftime"
dependsonhowmanydifferentpasswords,the"
passwords,andyourcomputer'
sspecification."
Justbepatient!
Makemeacoffee!
ConstMSGPWORDFOUND1AsString="
YouhadaWorksheet"
StructureorWindowsPasswordset."
Thepasswordfoundwas:
$$"
Noteitdownforpotentialfutureuseinotherworkbooksby"
thesamepersonwhosetthispassword."
Nowtocheckandclearotherpasswords."
ConstMSGPWORDFOUND2AsString="
passwordset."
Noteitdownforpotential"
futureuseinotherworkbooksbysamepersonwho"
setthispassword."
Nowtocheckandclear"
otherpasswords."
ConstMSGONLYONEAsString="
Onlystructure/windows"
protectedwiththepasswordthatwasjustfound."
ALLCLEAR&
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)&
MsgBoxApplication.Substitute(MSGPWORDFOUND1,_
PWord1),vbInformation,HEADER
ExitDo'
Bypassallfor...nexts
Next:
Next
LoopUntilTrue
OnErrorGoTo0
IfWinTagAndNotShTagThen
MsgBoxMSGONLYONE,vbInformation,HEADER
AttemptclearancewithPWord1
w1.UnprotectPWord1
ShTag=Fal