Excel撤销工作表保护密码图文教程2020攻略资讯( 二 ) _Excel

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
----------------------
复制到横线以上