2024年1月5日发(作者：)

如何破解EXCEL工作表保护密码

1. 工具---宏----录制新宏---输入名字如:hh

2. 3

停止录制(这样得到一个空宏)

3. 4

工具---宏----宏,选hh,点编辑按钮

精心整理

选择“个人宏工作簿”后按确定，弹出如下“暂停”按钮，点击停止：

1. 点击“运行”按钮后，弹出“宏”对话框，

点击运行“!工作保护密码破解”这个宏

2. 9

9、运行“!工作保护密码破解”这个宏后，

如下图示意就可以解除工作表的密码保护了

3. 10

（这个图，如果工作表中有多组不同密码，

每解开一组，就会提示一次，也就说可能会出现几次）

精心整理

4. 11

工作表保护密码破解(代码）

=========请复制以下内容=============

PublicSub工作表保护密码破解()

ConstDBLSPACEAsString=vbNewLine&vbNewLine

ConstAUTHORSAsString=DBLSPACE&vbNewLine&_

"作者:McCormick JEMcGimpsey"

ConstHEADERAsString="工作表保护密码破解"

ConstVERSIONAsString=DBLSPACE&"版本Version1.1.1"

ConstREPBACKAsString=DBLSPACE&""

ConstZHENGLIAsString=DBLSPACE&" hfhzi3—戊冥整理"

ConstALLCLEARAsString=DBLSPACE&"该工作簿中的工作表密码保护已全部解除!!"&DBLSPACE&"请记得另保存"_

精心整理

&DBLSPACE&"注意：不要用在不当地方，要尊重他人的劳动成果！"

ConstMSGNOPWORDS1AsString="该文件工作表中没有加密"

ConstMSGNOPWORDS2AsString="该文件工作表中没有加密2"

ConstMSGTAKETIMEAsString="解密需花费一定时间,请耐心等候!"&DBLSPACE&"按确定开始破解!"

ConstMSGPWORDFOUND1AsString="密码重新组合为:"&DBLSPACE&"$$"&DBLSPACE&_

"如果该文件工作表有不同密码,将搜索下一组密码并修改清除"

ConstMSGPWORDFOUND2AsString="密码重新组合为:"&DBLSPACE&"$$"&DBLSPACE&_

"如果该文件工作表有不同密码,将搜索下一组密码并解除"

ConstMSGONLYONEAsString="确保为唯一的?"

Dimw1AsWorksheet,w2AsWorksheet

DimiAsInteger,jAsInteger,kAsInteger,lAsInteger

DimmAsInteger,nAsInteger,i1AsInteger,i2AsInteger

Dimi3AsInteger,i4AsInteger,i5AsInteger,i6AsInteger

DimPWord1AsString

DimShTagAsBoolean,WinTagAsBoolean

Updating=False

WithActiveWorkbook

WinTag=.tWindows

EndWith

ShTag=False

ForEachw1InWorksheets

ShTag=tContents

Nextw1

IfNotShTagAndNotWinTagThen

MsgBoxMSGNOPWORDS1,vbInformation,HEADER

ExitSub

EndIf

MsgBoxMSGTAKETIME,vbInformation,HEADER

IfNotWinTagThen

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)

tStructure=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)

tute(MSGPWORDFOUND1,_

"$$",PWord1),vbInformation,HEADER

s

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

ectPWord1

Nextw1

精心整理

OnErrorGoTo0

ShTag=False

ForEachw1InWorksheets

'ChecksforallclearShTagtriggeredto1ifnot.

ShTag=tContents

Nextw1

IfShTagThen

ForEachw1InWorksheets

Withw1

tContentsThen

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)

tContentsThen

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)

tute(MSGPWORDFOUND2,_

"$$",PWord1),vbInformation,HEADER

'leveragefindingPwordbytryingonothersheets

ForEachw2InWorksheets

ectPWord1

Nextw2

s

EndIf

Next:Next:Next:Next:Next:Next

Next:Next:Next:Next:Next:Next

精心整理

LoopUntilTrue

OnErrorGoTo0

EndIf

EndWith

Nextw1

EndIf

MsgBoxALLCLEAR&AUTHORS&VERSION&REPBACK&ZHENGLI,vbInformation,HEADER

EndSub

精心整理