如何破解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 = ＂CMG=＂＂＂ Then CMGs = i If GetData = ＂[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, DPBo + 16, s20"替换加密部份机码 For i = CMGs To DPBo Step 2 Put #1, i, St Next"加入不配对符号 If (DPBo - CMGs) Mod 2 0 Then Put #1, DPBo + 1, 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 = ＂CMG=＂＂＂ Then CMGs = i If GetData = ＂[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, DPBo + 16, s20"替换加密部份机码 For i = CMGs To DPBo Step 2 Put #1, i, St Next"加入不配对符号 If (DPBo - CMGs) Mod 2 0 Then Put #1, DPBo + 1, s20 End If MsgBox ＂文件解密成功......＂， 32， ＂提示＂ Close #1 End Sub VBA代码引用自：

求一个EXCEL加载宏密码破解工具,要免费的,万分感谢

将以下代码插入模块后运行Private Sub VBAPassword（) "你要解保护的Excel文件路径Filename = Application.GetOpenFilename(＂Excel文件（*.xls & *.xla & *.xlt *.xlsx *.xlsb）,*.xls;*.xla;*.xlt;*.xlsx;*.xlsb＂, , ＂VBA破解＂）If Dir(Filename) = ＂＂ ThenMsgBox ＂没找到相关文件，清重新设置。

＂Exit SubElseFileCopy Filename, Filename & ＂.bak＂ "备份文件。

End IfDim GetData As String * 5Open Filename For Binary As #1Dim CMGs As LongDim DPBo As LongFor i = 1 To LOF(1)Get #1, i, GetDataIf GetData = ＂CMG=＂＂＂ Then CMGs = iIf GetData = ＂[Host＂ Then DPBo = i - 2: Exit ForNextIf CMGs = 0 ThenMsgBox ＂请先对VBA编码设置一个保护密码...＂， 32， ＂提示＂Exit SubEnd IfDim St As String * 2Dim s20 As String * 1 "取得一个0D0A十六进制字串Get #1, CMGs - 2, St "取得一个20十六制字串Get #1, DPBo + 16, s20 "替换加密部份机码For i = CMGs To DPBo Step 2Put #1, i, StNext "加入不配对符号If (DPBo - CMGs) Mod 2 <> 0 ThenPut #1, DPBo + 1, s20End IfMsgBox ＂文件解密成功......＂， 32， ＂提示＂Close #1End Sub

如何破解excel宏的保护密码

只要按照以下步骤操作，Excel工作表保护密码瞬间即破！ 1、打开您需要破解保护密码的Excel文件； 2、依次点击菜单栏上的工具---宏----录制新宏，输入宏名字如：aa; 3、停止录制（这样得到一个空宏）； 4、依次点击菜单栏上的工具---宏----宏，选aa，点编辑按钮；5、删除窗口中的所有字符（只有几个），替换为下面的内容；从横线下开始复制------------------------------------------------------------------------------------------ Option Explicit Public Sub AllInternalPasswords() " Breaks worksheet and workbook structure passwords. Bob McCormick " probably originator of base code algorithm modified for coverage " of workbook structure / windows passwords and for multiple passwords " " Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) " Modified 2003-Apr-04 by JEM: All msgs to constants, and " eliminate one Exit Sub (Version 1.1.1) " Reveals hashed passwords NOT original passwords Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine & _ ＂Adapted from Bob McCormick base code by＂ & _ ＂Norman Harker and JE McGimpsey＂ Const HEADER As String = ＂AllInternalPasswords User Message＂ Const VERSION As String = DBLSPACE & ＂Version 1.1.1 2003-Apr-04＂ Const REPBACK As String = DBLSPACE & ＂Please report failure ＂ & _ ＂to the microsoft.public.excel.programming newsgroup.＂ Const ALLCLEAR As String = DBLSPACE & ＂The workbook should ＂ & _ ＂now be free of all password protection, so make sure you:＂ & _ DBLSPACE & ＂SAVE IT NOW!＂ & DBLSPACE & ＂and also＂ & _ DBLSPACE & ＂BACKUP!, BACKUP!!, BACKUP!!!＂ & _ DBLSPACE & ＂Also, remember that the password was ＂ & _ ＂put there for a reason. Don"t stuff up crucial formulas ＂ & _ ＂or data.＂ & DBLSPACE & ＂Access and use of some data ＂ & _ ＂may be an offense. If in doubt, don"t.＂ Const MSGNOPWORDS1 As String = ＂There were no passwords on ＂ & _ ＂sheets, or workbook structure or windows.＂ & AUTHORS & VERSION Const MSGNOPWORDS2 As String = ＂There was no protection to ＂ & _ ＂workbook structure or windows.＂ & DBLSPACE & _ ＂Proceeding to unprotect sheets.＂ & AUTHORS & VERSION Const MSGTAKETIME As String = ＂After pressing OK button this ＂ & _ ＂will take some time.＂ & DBLSPACE & ＂Amount of time ＂ & _ ＂depends on how many different passwords, the ＂ & _ ＂passwords, and your computer"s specification.＂ & DBLSPACE & _ ＂Just be patient! Make me a coffee!＂ & AUTHORS & VERSION Const MSGPWORDFOUND1 As String = ＂You had a Worksheet ＂ & _ ＂Structure or Windows Password set.＂ & DBLSPACE & _ ＂The password found was: ＂ & DBLSPACE & ＂$$＂ & DBLSPACE & _ ＂Note it down for potential future use in other workbooks by ＂ & _ ＂the same person who set this password.＂ & DBLSPACE & _ ＂Now to check and clear other passwords.＂ & AUTHORS & VERSION Const MSGPWORDFOUND2 As String = ＂You had a Worksheet ＂ & _ ＂password set.＂ & DBLSPACE & ＂The password found was: ＂ & _ DBLSPACE & ＂$$＂ & DBLSPACE & ＂Note it down for potential ＂ & _ ＂future use in other workbooks by same person who ＂ & _ ＂set this password.＂ & DBLSPACE & ＂Now to check and clear ＂ & _ ＂other passwords.＂ & AUTHORS & VERSION Const MSGONLYONE As String = ＂Only structure / windows ＂ & _ ＂protected with the password that was just found.＂ & _ ALLCLEAR & AUTHORS & VERSION & REPBACK Dim w1 As Worksheet, w2 As Worksheet Dim i As Integer, j As Integer, k As Integer, l As Integer Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean Application.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then MsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End If MsgBox MSGTAKETIME, vbInformation, HEADER If Not WinTag Then MsgBox MSGNOPWORDS2, vbInformation, HEADER Else On Error Resume Next Do "dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 With ActiveWorkbook ....

如何激活EXCEL中的宏？

教你如何轻松的破解excel 2010工作表密码现在我们就开始录制新宏我就用我自己的加密的excel文件叫大家怎么破解清除excel密码，首先打开有自己加密的excel文档，如下图：教你如何轻松的破解excel 2010工作表密码excel2010和以前的版本有所不同，功能更人性化，excel为宏设置默认是关闭的。

如下图所示；“文件”下的子菜单”选项“如下图所示：教你如何轻松的破解excel 2010工作表密码点击“选项”选择子菜单下“信任中心”“宏设置”在宏设置下，宏名：随便填，我这么久填密码，保存在：选择当前工作薄，说明可以不填。

选择“启用所以宏”然后点击“确定”如下图所示：教你如何轻松的破解excel 2010工作表密码点击“视图”在右下面我们会看“宏”打开宏，如下图所示，我们要启用宏，就必须开启宏，加载宏文件，更智能化。

首先我们要做的是...

哪位大侠有Excel VBA “宏的密码” 破解工具,小弟急用,在线等,...

试试这个宏看看—— Option Explicit Sub CreateReport() On Error Resume Next Application.ScreenUpdating = False Dim wst As Worksheet, c As Range, i%, j%, intCol% With ActiveSheet Set wst = Worksheets.Add(After:=Sheets(Worksheets.Count)) wst.[A1] = ＂EVT/DVT TEST PLAN FORM＂ wst.[A2] = JoinString(.Range(＂A3:D＂ & Application.Match(＂Item＂, .[A:A], 0) - 1)) Set c = .[B:B].Find(＂Leakage ID＂, LookIn:=xlValues) End With With wst If Not c Is Nothing Then c.CurrentRegion.Copy .[A3] .Cells.ClearFormats For i = 3 To .[BZ4].End(xlToLeft).Column - 3 Step 2 For j = 5 To .[A65536].End(xlUp).Row If Len(.Cells(j, i)) = 0 Then .Cells(j, i) = Application.Substitute(.Cells(j, i + 1), .Cells(3, i), ＂＂) End If Next j Next i .Columns(2).Delete For i = 2 To .[BZ4].End(xlToLeft).Column If Len(.Cells(3, i)) = 0 Then .Cells(3, i).EntireColumn.Delete Next i .Columns(Application.CountA(.Rows(3))).Delete .[A3:A4].Merge intCol = .[BZ3].End(xlToLeft).Column .Range(.Cells(1, 1), .Cells(1, intCol)).Merge .Range(.Cells(2, 1), .Cells(2, intCol)).Merge .Range(.Cells(3, intCol - 2), .Cells(4, intCol - 2)).Merge .Range(.Cells(3, intCol - 1), .Cells(4, intCol - 1)).Merge .Range(.Cells(3, intCol), .Cells(4, intCol)).Merge .Rows(.[A:A].Find(＂Total:＂, LookIn:=xlValues).Row & ＂:＂ & 65536).Clear .[A1].Font.Bold = True .Rows(2).RowHeight = 140 .[A2].WrapText = True .[A3].Resize(.[A3].CurrentRegion.Rows.Count - 2, .[A3].CurrentRegion.Columns.Count).Borders.LineStyle = xlContinuous .[A1].CurrentRegion.HorizontalAlignment = xlCenter .Range(.Cells(4, 1), .Cells(4, .[A3].CurrentRegion.Columns.Count)).WrapText = True .Range(.Cells(3, 1), .Cells(3, .[A3].CurrentRegion.Columns.Count)).Font.Bold = True .[A1].CurrentRegion.Font.Size = 10 .[A1].CurrentRegion.Columns.AutoFit .[A1].Font.Size = 14 End If End With Set wst = Nothing Set c = Nothing Application.ScreenUpdating = True End Sub Function JoinString(rng As Range) Dim i%, str$ For i = 1 To Int(rng.Cells.Count / 4) str = str & rng.Cells(i, 1) & rng.Cells(i, 2) & ＂ ＂ & rng.Cells(i, 3) & rng.Cells(i, 4) & vbCrLf Next JoinString = Left(str, Len(str) - 1) End Function