经验直达：

• 如何破解excel宏的密码
• excel密码怎么破解
• excel密码破解代码

一、如何破解excel宏的密码

EXCEL工程密破解,以下方法十分有效的帮你打开VBA工程密码保护的工程,教你破解VBA工程密码,解除VBA工程密码保护下的EXCEL文档,破解EXCEL原来如此简单.--------------在办公中我们常看到许多用宏(VBA)编写的EXCEL表格,而这些表格就如同一个数据库,我们可以选取或查询很多的数据,一般的这些数据是存放在一个隐藏的工作表中的,那么要如何显示这个隐藏的工作表呢?我们可以打开宏编辑器(ALT F11),再安CTRL R打开专案,这时弹出窗会有所有的这个EXCEL的工用表,这时你就可以看看那些是被隐藏的了,很多时候打开是需要密码的,用以下方法解密后,再将解密后文件打开,依同样方法在工作表标签中右键>>检视程式码>>复制以下代码>>按F8执行

Private Sub CommandButton1_Click()

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

End Sub

关于破解EXCEL VBA工程密码的方法,以下代码非常有效,首先建一新EXCEL文件,在工作表标签处右点>>检视程式码>>复制以下代码>>按F8执行在弹出窗中选你要你破解工程密码的EXCEL文件>>再按F5执行即可.

Private Sub VBAPassword()
'你要解保护的Excel文件路径
Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解")
If Dir(Filename) = "" Then
MsgBox "没找到相关文件,清重新设置 。"
Exit Sub
Else
FileCopy Filename, Filename & ".bak" '备份文件 。
End If

Dim GetData As String * 5
Open Filename For Binary As #1
Dim CMGs As Long
Dim DPBo As Long
For i = 1 To LOF(1)
Get #1, i, GetData
If GetData = "https://www.itzhengshu.com/excel/CMG=""" Then CMGs = i
If GetData = "https://www.itzhengshu.com/excel/[Host" Then DPBo = i - 2: Exit For
Next

If CMGs = 0 Then
MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
Exit Sub
End If

If Protect = False Then
Dim St As String * 2
Dim s20 As String * 1

'取得一个0D0A十六进制字串
Get #1, CMGs - 2, St

'取得一个20十六制字串
Get #1, DPBo16, s20

'替换加密部份机码
For i = CMGs To DPBo Step 2
Put #1, i, St
Next

'加入不配对符号
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo1, s20
End If
MsgBox "文件解密成功......", 32, "提示"
End If
Close #1
End Sub

如果上面代码不能运行或出错,请用以下代码重试.

Private Sub VBAPassword()
'你要解保护的Excel文件路径
Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解")

If Dir(Filename) = "" Then
MsgBox "没找到相关文件,清重新设置 。"
Exit Sub
Else
FileCopy Filename, Filename & ".bak" '备份文件 。
End If

Dim GetData As String * 5
Open Filename For Binary As #1
Dim CMGs As Long
Dim DPBo As Long
For i = 1 To LOF(1)
Get #1, i, GetData
If GetData = "https://www.itzhengshu.com/excel/CMG=""" Then CMGs = i
If GetData = "https://www.itzhengshu.com/excel/[Host" Then DPBo = i - 2: Exit For
Next

If CMGs = 0 Then
MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
Exit Sub
End If

Dim St As String * 2
Dim s20 As String * 1

'取得一个0D0A十六进制字串
Get #1, CMGs - 2, St

'取得一个20十六制字串
Get #1, DPBo16, s20

'替换加密部份机码
For i = CMGs To DPBo Step 2
Put #1, i, St
Next

'加入不配对符号
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo1, s20
End If
MsgBox "文件解密成功......", 32, "提示"

Close #1
End Sub

二、excel密码怎么破解

操作方法：

• 01
  打开excel工作表 。
  
• 02
  然后在Excel表中找到【视图】 。
  
• 03
  点开【宏】 。
  
• 04
  然后选择【录制宏】 。
  
• 05
  接着会弹出一个窗口，点击【确定】 。
  
• 06
  在此点开【宏】，点击【停止录制】 。
  
• 07
  然后再点击【宏】，弹出窗口点击【编辑】 。
  
• 08
  然后点击【模板1】，并清空右边红框里的代码，如下图 。
  
• 09
  然后把破解代码复制粘贴进入空白处（破解代码小编将在文章最底部分享给大家） 。
  
• 10
  然后在打开【查看宏】，点击执行破解代码 。
  
• 11
  会弹出一个框 ， 是英文的，看不懂没关系，点击确定，解密需要一段时间 。
  
• 12
  破解代码:
  PublicSubAllInternalPasswords()
  'Breaksworksheetandworkbookstructurepasswords.BobMcCormick
  'probablyoriginatorofbasecodealgorithmmodifiedforcoverage
  'ofworkbookstructure/windowspasswordsandformultiplepasswords
  '
  'NormanHarkerandJEMcGimpsey27-Dec-2002(Version1.1)
  'Modified2003-Apr-04byJEM:Allmsgstoconstants,and
  'eliminateoneExitSub(Version1.1.1)
  'RevealshashedpasswordsNOToriginalpasswords
  ConstDBLSPACEAsString=vbNewLine&vbNewLine
  ConstAUTHORSAsString=DBLSPACE&vbNewLine&_
  "AdaptedfromBobMcCormickbasecodeby"&_
  "NormanHarkerandJEMcGimpsey"
  ConstHEADERAsString="AllInternalPasswordsUserMessage"
  ConstVERSIONAsString=DBLSPACE&"Version1.1.12003-Apr-04"
  ConstREPBACKAsString=DBLSPACE&"Pleasereportfailure"&_
  "tothemicrosoft.public.excel.programmingnewsgroup."
  ConstALLCLEARAsString=DBLSPACE&"Theworkbookshould"&_
  "nowbefreeofallpasswordprotection,somakesureyou:"&_
  DBLSPACE&"SAVEITNOW!"&DBLSPACE&"andalso"&_
  DBLSPACE&"BACKUP!,BACKUP!!,BACKUP!!!"&_
  DBLSPACE&"Also,rememberthatthepasswordwas"&_
  "putthereforareason.Don'tstuffupcrucialformulas"&_
  "ordata."&DBLSPACE&"Accessanduseofsomedata"&_
  "maybeanoffense.Ifindoubt,don't."
  ConstMSGNOPWORDS1AsString="Therewerenopasswordson"&_
  "sheets,orworkbookstructureorwindows."&AUTHORS&VERSION
  ConstMSGNOPWORDS2AsString="Therewasnoprotectionto"&_
  "workbookstructureorwindows."&DBLSPACE&_
  "Proceedingtounprotectsheets."&AUTHORS&VERSION
  ConstMSGTAKETIMEAsString="AfterpressingOKbuttonthis"&_
  "willtakesometime."&DBLSPACE&"Amountoftime"&_
  "dependsonhowmanydifferentpasswords,the"&_
  "passwords,andyourcomputer'sspecification."&DBLSPACE&_
  "Justbepatient!Makemeacoffee!"&AUTHORS&VERSION
  ConstMSGPWORDFOUND1AsString="YouhadaWorksheet"&_
  "StructureorWindowsPasswordset."&DBLSPACE&_
  "Thepasswordfoundwas:"&DBLSPACE&""&DBLSPACE&_
  "Noteitdownforpotentialfutureuseinotherworkbooksby"&_
  "thesamepersonwhosetthispassword."&DBLSPACE&_
  "Nowtocheckandclearotherpasswords."&AUTHORS&VERSION
  ConstMSGPWORDFOUND2AsString="YouhadaWorksheet"&_
  "passwordset."&DBLSPACE&"Thepasswordfoundwas:"&_
  DBLSPACE&""&DBLSPACE&"Noteitdownforpotential"&_
  "futureuseinotherworkbooksbysamepersonwho"&_
  "setthispassword."&DBLSPACE&"Nowtocheckandclear"&_
  "otherpasswords."&AUTHORS&VERSION
  ConstMSGONLYONEAsString="Onlystructure/windows"&_
  "protectedwiththepasswordthatwasjustfound."&_
  ALLCLEAR&AUTHORS&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&nbs
  

三、excel密码破解代码

【excel密码怎么破解 如何破解excel宏的密码】EXCEL密码破解x0dx0ax0dx0a1打开文件x0dx0a2工具---宏----录制新宏---输入名字如:aax0dx0a3停止录制(这样得到一个空宏)x0dx0a4工具---宏----宏,选aa,点编辑按钮x0dx0a5删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧)x0dx0a6关闭编辑窗口x0dx0a7工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!!x0dx0a内容如下：x0dx0aPublic Sub AllInternalPasswords() x0dx0a' Breaks worksheet and workbook structure passwords. Bob McCormick x0dx0a' probably originator of base code algorithm modified for coverage x0dx0a' of workbook structure / windows passwords and for multiple passwords x0dx0a' x0dx0a' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) x0dx0a' Modified 2003-Apr-04 by JEM: All msgs to constants, and x0dx0a' eliminate one Exit Sub (Version 1.1.1) x0dx0a' Reveals hashed passwords NOT original passwords x0dx0aConst DBLSPACE As String = vbNewLine & vbNewLine x0dx0aConst AUTHORS As String = DBLSPACE & vbNewLine & _ x0dx0a"Adapted from Bob McCormick base code by" & _ x0dx0a"Norman Harker and JE McGimpsey" x0dx0aConst HEADER As String = "AllInternalPasswords User Message" x0dx0aConst VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" x0dx0aConst REPBACK As String = DBLSPACE & "Please report failure " & _ x0dx0a"to the microsoft.public.excel.programming newsgroup." x0dx0aConst ALLCLEAR As String = DBLSPACE & "The workbook should " & _ x0dx0a"now be free of all password protection, so make sure you:" & _ x0dx0aDBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ x0dx0aDBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ x0dx0aDBLSPACE & "Also, remember that the password was " & _ x0dx0a"put there for a reason. Don't stuff up crucial formulas " & _ x0dx0a"or data." & DBLSPACE & "Access and use of some data " & _ x0dx0a"may be an offense. If in doubt, don't." x0dx0aConst MSGNOPWORDS1 As String = "There were no passwords on " & _ x0dx0a"sheets, or workbook structure or windows." & AUTHORS & VERSION x0dx0aConst MSGNOPWORDS2 As String = "There was no protection to " & _ x0dx0a"workbook structure or windows." & DBLSPACE & _ x0dx0a"Proceeding to unprotect sheets." & AUTHORS & VERSION x0dx0aConst MSGTAKETIME As String = "After pressing OK button this " & _ x0dx0a"will take some time." & DBLSPACE & "Amount of time " & _ x0dx0a"depends on how many different passwords, the " & _ x0dx0a"passwords, and your computer's specification." & DBLSPACE & _ x0dx0a"Just be patient! Make me a coffee!" & AUTHORS & VERSION x0dx0aConst MSGPWORDFOUND1 As String = "You had a Worksheet " & _ x0dx0a"Structure or Windows Password set." & DBLSPACE & _ x0dx0a"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ x0dx0a"Note it down for potential future use in other workbooks by " & _ x0dx0a"the same person who set this password." & DBLSPACE & _ x0dx0a"Now to check and clear other passwords." & AUTHORS & VERSION x0dx0aConst MSGPWORDFOUND2 As String = "You had a Worksheet " & _ x0dx0a"password set." & DBLSPACE & "The password found was: " & _ x0dx0aDBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ x0dx0a"future use in other workbooks by same person who " & _ x0dx0a"set this password." & DBLSPACE & "Now to check and clear " & _ x0dx0a"other passwords." & AUTHORS & VERSION x0dx0aConst MSGONLYONE As String = "Only structure / windows " & _ x0dx0a"protected with the password that was just found." & _ x0dx0aALLCLEAR & AUTHORS & VERSION & REPBACK x0dx0aDim w1 As Worksheet, w2 As Worksheet x0dx0aDim i As Integer, j As Integer, k As Integer, l As Integer x0dx0aDim m As Integer, n As Integer, i1 As Integer, i2 As Integer x0dx0aDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer x0dx0aDim PWord1 As String x0dx0aDim ShTag As Boolean, WinTag As Boolean x0dx0aApplication.ScreenUpdating = False x0dx0aWith ActiveWorkbook x0dx0aWinTag = .ProtectStructure Or .ProtectWindows x0dx0aEnd With x0dx0aShTag = False x0dx0aFor Each w1 In Worksheets x0dx0aShTag = ShTag Or w1.ProtectContents x0dx0aNext w1 x0dx0aIf Not ShTag And Not WinTag Then x0dx0aMsgBox MSGNOPWORDS1, vbInformation, HEADER x0dx0aExit Sub x0dx0aEnd If x0dx0aMsgBox MSGTAKETIME, vbInformation, HEADER x0dx0aIf Not WinTag Then x0dx0aMsgBox MSGNOPWORDS2, vbInformation, HEADER x0dx0aElse x0dx0aOn Error Resume Next x0dx0aDo 'dummy do loop x0dx0aFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 x0dx0aFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 x0dx0aFor i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 x0dx0aFor i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 x0dx0aWith ActiveWorkbook x0dx0a.Unprotect Chr(i) & Chr(j) & Chr(k) & _ x0dx0aChr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ x0dx0aChr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) x0dx0aIf .ProtectStructure = False And _ x0dx0a.ProtectWindows = False Then x0dx0aPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ x0dx0aChr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ x0dx0aChr(i4) & Chr(i5) & Chr(i6) & Chr(n) x0dx0aMsgBox Application.Substitute(MSGPWORDFOUND1, _ x0dx0a"$$", PWord1), vbInformation, HEADER x0dx0aExit Do 'Bypass all for...nexts x0dx0aEnd If x0dx0aEnd With x0dx0aNext: Next: Next: Next: Next: Next x0dx0aNext: Next: Next: Next: Next: Next x0dx0aLoop Until True x0dx0aOn Error GoTo 0 x0dx0aEnd If x0dx0aIf WinTag And Not ShTag Then x0dx0aMsgBox MSGONLYONE, vbInformation, HEADER x0dx0aExit Sub x0dx0aEnd If x0dx0aOn Error Resume Next x0dx0aFor Each w1 In Worksheets x0dx0a'Attempt clearance with PWord1 x0dx0aw1.Unprotect PWord1 x0dx0aNext w1 x0dx0aOn Error GoTo 0 x0dx0aShTag = False x0dx0aFor Each w1 In Worksheets x0dx0a'Checks for all clear ShTag triggered to 1 if not. x0dx0aShTag = ShTag Or w1.ProtectContents x0dx0aNext w1 x0dx0aIf ShTag Then x0dx0aFor Each w1 In Worksheets x0dx0aWith w1 x0dx0aIf .ProtectContents Then x0dx0aOn Error Resume Next x0dx0aDo 'Dummy do loop x0dx0aFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66 x0dx0aFor l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 x0dx0aFor i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 x0dx0aFor i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 x0dx0a.Unprotect Chr(i) & Chr(j) & Chr(k) & _ x0dx0aChr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ x0dx0aChr(i4) & Chr(i5) & Chr(i6) & Chr(n) x0dx0aIf Not .ProtectContents Then x0dx0aPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ x0dx0aChr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ x0dx0aChr(i4) & Chr(i5) & Chr(i6) & Chr(n) x0dx0aMsgBox Application.Substitute(MSGPWORDFOUND2, _ x0dx0a"$$", PWord1), vbInformation, HEADER x0dx0a'leverage finding Pword by trying on other sheets x0dx0aFor Each w2 In Worksheets x0dx0aw2.Unprotect PWord1 x0dx0aNext w2 x0dx0aExit Do 'Bypass all for...nexts x0dx0aEnd If x0dx0aNext: Next: Next: Next: Next: Next x0dx0aNext: Next: Next: Next: Next: Next x0dx0aLoop Until True x0dx0aOn Error GoTo 0 x0dx0aEnd If x0dx0aEnd With x0dx0aNext w1 x0dx0aEnd If x0dx0aMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER x0dx0aEnd Sub

相关经验推荐

• excel表格上不显示数字了怎么回事 excel表格里的数字为什么会自己消失了
• 怎么在Excel中锁定单元格并设置密码 Excel表格中如何锁定表格并加上密码
• excel表格竖排数字如何相加 求和公式excel怎么做一竖行求和
• 在excel中如何求ln的取值 excel怎么取对数ln
• 教你快速删除excel中的空行和列 excel怎么删除大量的空白行和列
• 如何在Excel表里使用ln函数 如何使用Excel的ln函数
• 如何用Excel绘制误差线 excel如何做误差线图表
• 在excel中怎么删除筛选出来的数据 怎么在excel表格中取消筛选
• 如何在excel中为整个工作表编页码 表格如何添加页码编号