Excel破解宏代码.docx

资源描述

Excel破解宏代码.docx

《Excel破解宏代码.docx》由会员分享，可在线阅读，更多相关《Excel破解宏代码.docx（12页珍藏版）》请在冰豆网上搜索。

Excel破解宏代码.docx

Excel破解宏代码

Excel工作表保护密码破解

方法:

1\打开文件

2\工具---宏----录制新宏---输入名字如:

3\停止录制（这样得到一个空宏）

4\工具---宏----宏,选aa,点编辑按钮

5\删除窗口中的所有字符（只有几个）,替换为下面的内容:

（复制吧）

6\关闭编辑窗口

7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,密码完全被你看见了!

内容如下:

PublicSubAllInternalPasswords（）

'Breaksworksheetand

workbookstructurepasswords.BobMcCormick

'probablyoriginatorofbase

codealgorithmmodifiedforcoverage

'ofworkbookstructure/windows

passwordsandformultiplepasswords

'NormanHarkerandJEMcGimpsey

27-Dec-2002（Version1.1）

'Modified2003-Apr-04byJEM:

Allmsgsto

constants,and

'eliminateoneExitSub（Version1.1.1）

'Revealshashed

passwordsNOToriginalpasswords

ConstDBLSPACEAsString=vbNewLine&

vbNewLine

ConstAUTHORSAsString=DBLSPACE&vbNewLine&_

"AdaptedfromBobMcCormickbasecodeby"&_

"NormanHarkerandJE

McGimpsey"

ConstHEADERAsString="AllInternalPasswordsUserMessage"

ConstVERSIONAsString=DBLSPACE&"Version1.1.12003-Apr-04"

ConstREPBACKAsString=DBLSPACE&"Pleasereportfailure"&_

"tothemicrosoft.public.excel.programmingnewsgroup."

ConstALLCLEARAs

String=DBLSPACE&"Theworkbookshould"&_

"nowbefreeofall

passwordprotection,somakesureyou:

"&_

DBLSPACE&"SAVEIT

NOW!

"&DBLSPACE&"andalso"&_

DBLSPACE&"BACKUP!

BACKUP!

"&_

DBLSPACE&"Also,rememberthatthe

passwordwas"&_

"putthereforareason.Don'tstuffupcrucial

formulas"&_

"ordata."&DBLSPACE&"Accessanduseofsome

data"&_

"maybeanoffense.Ifindoubt,don't."

Const

MSGNOPWORDS1AsString="Therewerenopasswordson"&_

"sheets,or

workbookstructureorwindows."&AUTHORS&VERSION

Const

MSGNOPWORDS2AsString="Therewasnoprotectionto"&_

"workbook

structureorwindows."&DBLSPACE&_

"Proceedingtounprotect

sheets."&AUTHORS&VERSION

ConstMSGTAKETIMEAsString="After

pressingOKbuttonthis"&_

"willtakesometime."&DBLSPACE

&"Amountoftime"&_

"dependsonhowmanydifferentpasswords,

the"&_

"passwords,andyourcomputer'sspecification."&DBLSPACE

"Justbepatient!

Makemeacoffee!

"&AUTHORS&VERSION

ConstMSGPWORDFOUND1AsString="YouhadaWorksheet"&_

"StructureorWindowsPasswordset."&DBLSPACE&_

"The

passwordfoundwas:

"&DBLSPACE&"$$"&DBLSPACE&_

"Note

itdownforpotentialfutureuseinotherworkbooksby"&_

"thesame

personwhosetthispassword."&DBLSPACE&_

"Nowtocheckand

clearotherpasswords."&AUTHORS&VERSION

ConstMSGPWORDFOUND2As

String="YouhadaWorksheet"&_

"passwordset."&DBLSPACE&

"Thepasswordfoundwas:

"&_

DBLSPACE&"$$"&DBLSPACE&

"Noteitdownforpotential"&_

"futureuseinotherworkbooksbysame

personwho"&_

"setthispassword."&DBLSPACE&"Nowtocheck

andclear"&_

"otherpasswords."&AUTHORS&VERSION

Const

MSGONLYONEAsString="Onlystructure/windows"&_

"protectedwith

thepasswordthatwasjustfound."&_

ALLCLEAR&AUTHORS&

VERSION&REPBACK

Dimw1AsWorksheet,w2AsWorksheet

DimiAs

Integer,jAsInteger,kAsInteger,lAsInteger

DimmAsInteger,nAs

Integer,i1AsInteger,i2AsInteger

Dimi3AsInteger,i4AsInteger,i5

AsInteger,i6AsInteger

DimPWord1AsString

DimShTagAsBoolean,

WinTagAsBoolean

Application.ScreenUpdating=False

WithActiveWorkbook

WinTag=

.ProtectStructureOr.ProtectWindows

EndWith

ShTag=False

ForEach

w1InWorksheets

ShTag=ShTagOrw1.ProtectContents

Nextw1

IfNot

ShTagAndNotWinTagThen

MsgBoxMSGNOPWORDS1,vbInformation,HEADER

ExitSub

EndIf

MsgBoxMSGTAKETIME,vbInformation,HEADER

IfNot

WinTagThen

MsgBoxMSGNOPWORDS2,vbInformation,HEADER

Else

OnError

ResumeNext

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

LoopUntilTrue

OnErrorGoTo0

EndIf

WinTagAndNotShTagThen

MsgBoxMSGONLYONE,vbInformation,HEADER

Exit

Sub

EndIf

OnErrorResumeNext

ForEachw1InWorksheets

'AttemptclearancewithPWord1

w1.UnprotectPWord1

Nextw1

ErrorGoTo0

ShTag=False

ForEachw1InWorksheets

'Checksforall

clearShTagtriggeredto1ifnot.

ShTag=ShTagOrw1.ProtectContents

Nextw1

IfShTagThen

ForEachw1InWorksheets

Withw1

.ProtectContentsThen

OnErrorResumeNext

Do'Dummydoloop

Fori=

65To66:

Forj=65To66:

Fork=65To66

Forl=65To66:

Form=65To

66:

Fori1=65To66

Fori2=65To66:

Fori3=65To66:

Fori4=65To

Fori5=65To66:

Fori6=65To66:

Forn=32To126

.Unprotect

Chr（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）

MsgBox

Application.Substitute（MSGPWORDFOUND2,_

"$$",PWord1）,vbInformation,

HEADER

'leveragefindingPwordbytryingonothersheets

ForEachw2In

Worksheets

w2.UnprotectPWord1

Nextw2

ExitDo'Bypassall

for...nexts

EndIf

LoopUntilTrue

OnErrorGoTo0

EndIf

EndWith

Nextw1

EndIf

MsgBoxALLCLEAR&AUTHORS&

VERSION&REPBACK,vbInformation,HEADER

EndSubEXCEL工程密破解,以下方法十分有效的帮你打开VBA工程密码保护的工程,教你破解VBA工程密码,解除VBA工程密码保护下的EXCEL文档,破解EXCEL原来如此简单.--------------在办公中我们常看到许多用宏（VBA）编写的EXCEL表格,而这些表格就如同一个数据库,我们可以选取或查询很多的数据,一般的这些数据是存放在一个隐藏的工作表中的,那么要如何显示这个隐藏的工作表呢?

我们可以打开宏编辑器（ALT+F11）,再安CTRL+R打开专案,这时弹出窗会有所有的这个EXCEL的工用表,这时你就可以看看那些是被隐藏的了,很多时候打开是需要密码的,用以下方法解密后,再将解密后文件打开,依同样方法在工作表标签中右键>>检视程式码>>复制以下代码>>按F8执行PrivateSubCommandButton1_Click（）

Worksheets（"这里为你要显示的工作表名称"）.Visible=True

EndSub关于破解EXCEL

VBA工程密码的方法,以下代码非常有效,首先建一新EXCEL文件,在工作表标签处右点>>检视程式码>>复制以下代码>>按F8执行

在弹出窗中选你要你破解工程密码的EXCEL文件>>再按F5执行即可.PrivateSubVBAPassword（）

'你要解保护的Excel文件路径

Filename=

Application.GetOpenFilename（"Excel文件（*.xls&*.xla&

*.xlt）,*.xls;*.xla;*.xlt",,"VBA破解"）

IfDir（Filename）=""Then

MsgBox"没找到相关文件,清重新设置。

Exit

Sub

Else

FileCopyFilename,Filename&".bak"'备份文件。

EndIf

DimGetDataAsString*5

OpenFilenameForBinaryAs#1

DimCMGsAs

Long

DimDPBoAsLong

Fori=1ToLOF

（1）

Get#1,i,GetData

GetData="CMG="""ThenCMGs=i

IfGetData="[Host"ThenDPBo=i-2:

Exit

For

IfCMGs=0Then

MsgBox"请先对VBA编码设置一个保护密码...",32,"提示"

ExitSub

End

DimStAsString*2

Dims20AsString*1

'取得一个0D0A十六进制字串

Get#1,CMGs-2,St

'取得一个20十六制字串

Get#1,DPBo+16,s20

'替换加密部份机码

Fori=CMGsToDPBoStep2

Put#1,i,St

'加入不配对符号

If（DPBo-CMGs）Mod2<>0Then

Put#1,DPBo+1,

s20

EndIf

MsgBox"文件解密成功......",32,"提示"

Close#1

EndSub

展开阅读全文