Excel破解宏代码.docx
- 文档编号:12327541
- 上传时间:2023-04-18
- 格式:DOCX
- 页数:12
- 大小:17.71KB
Excel破解宏代码.docx
《Excel破解宏代码.docx》由会员分享,可在线阅读,更多相关《Excel破解宏代码.docx(12页珍藏版)》请在冰豆网上搜索。
Excel破解宏代码
Excel破解宏代码
Excel工作表保护密码破解
方法:
1\打开文件
2\工具---宏----录制新宏---输入名字如:
aa
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!
!
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
Next:
Next:
Next:
Next:
Next:
Next
Next:
Next:
Next:
Next:
Next:
Next
LoopUntilTrue
OnErrorGoTo0
EndIf
If
WinTagAndNotShTagThen
MsgBoxMSGONLYONE,vbInformation,HEADER
Exit
Sub
EndIf
OnErrorResumeNext
ForEachw1InWorksheets
'AttemptclearancewithPWord1
w1.UnprotectPWord1
Nextw1
On
ErrorGoTo0
ShTag=False
ForEachw1InWorksheets
'Checksforall
clearShTagtriggeredto1ifnot.
ShTag=ShTagOrw1.ProtectContents
Nextw1
IfShTagThen
ForEachw1InWorksheets
Withw1
If
.ProtectContentsThen
OnErrorResumeNext
Do'Dummydoloop
Fori=
65To66:
Forj=65To66:
Fork=65To66
Forl=65To66:
Form=65To
66:
Fori1=65To66
Fori2=65To66:
Fori3=65To66:
Fori4=65To
66
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
Next:
Next:
Next:
Next:
Next:
Next
Next:
Next:
Next:
Next:
Next:
Next
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
If
GetData="CMG="""ThenCMGs=i
IfGetData="[Host"ThenDPBo=i-2:
Exit
For
Next
IfCMGs=0Then
MsgBox"请先对VBA编码设置一个保护密码...",32,"提示"
ExitSub
End
If
DimStAsString*2
Dims20AsString*1
'取得一个0D0A十六进制字串
Get#1,CMGs-2,St
'取得一个20十六制字串
Get#1,DPBo+16,s20
'替换加密部份机码
Fori=CMGsToDPBoStep2
Put#1,i,St
Next
'加入不配对符号
If(DPBo-CMGs)Mod2<>0Then
Put#1,DPBo+1,
s20
EndIf
MsgBox"文件解密成功......",32,"提示"
Close#1
EndSub
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel 破解 代码