VBA工程密码忘记怎么办quchu？

Posted 2023-03-28

xlsm格式的表格VBA工程密码忘记了如何查看代码？急求大神指点

如果要查看别人的有密码保护的VBA代码，可使用此程序。使用方法：新建Excel工作簿, 打开VBA编辑器,新建一模块 ,复制以下代码。然后运行MoveProtect程序。运行过程中会出现提示，以指示要破解的文件路径和名称。被破解的文件一定是关闭状态的。
Sub MoveProtect()
Dim FileName As String
FileName = Application.GetOpenFilename_
("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
Exit Sub
Else
VBAPassword FileName, False ' 引用下面的自定义函数
End If
End Sub
Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
If Dir(FileName) = "" Then
Exit Function
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 Function
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, "提示"
Else
Dim MMs As String * 5
MMs = "DPB="""
Put #1, CMGs, MMs
MsgBox "对文件特殊加密成功......", 32, "提示"
End If
Close #1
End Function
所谓破解只是清除VBA密码，并不是真正的破解。追问

谢谢，但是对xlsm格式没有效果，请问如何操作？

参考技术A 打开VBE编辑窗口----工具菜单-----VBAProject属性（E）...---保护选项卡---------查看时锁定工程-----把其前面那个勾去掉-------最后记得保存一下文件-------再打开文件就没有VBA密码了。

组件
编辑

桌面产品
这些程序包括在Microsoft Office 2010的所有版本中，除了Microsoft Office Starter 2010。Microsoft Office Starter 2010并非公开销售的产品，它是购买品牌电脑时随机安装的，只包括入门版Word及Excel，而且在版面的右方有着无法移除的微软广告。
Word
主条目：Microsoft Word
Microsoft Word是文书处理软件，被认为是Office的主要程序，在文字处理软件市场上拥有统治份额，其私有的DOC格式被尊为一个行业的标准，虽然由Word 2007年已经转用DOCX格式。Word也适宜某些版本的Microsoft Works。它适宜Windows和Macintosh平台。它的主要竞争者是LibreOffice、Corel WordPerfect和ApplePages。
Excel
主条目：Microsoft Excel
Microsoft Excel是电子试算表程序（进行数字和预算运算的软件程序），与Microsoft Word一样，它在市场拥有统治份额。它最初对占优势的Lotus 1-2-3是个竞争者，但最后它卖得比它多、快，于是它成为了实际标准。它适宜Windows和Macintosh平台。它的主要竞争者是OpenOffice.org Calc、AppleNumbers和CorelQuattro Pro。
Outlook
主条目：Microsoft Outlook
Microsoft Outlook（不要与Outlook Express混淆）是个人信息管理程序和电子邮件通信软件。在Office 97版接任Microsoft Mail。它包括一个电子邮件客户端，日历，任务管理者，和地址本。它的电子邮件程序的主要竞争者是Mozilla Thunderbird（Mozilla）和Eudora。它的个人信息管理程序主要竞争者是Mozilla、苹果公司的Mail和Lotus Organizer。它的一个版本也被包括在大多数Pocket PC掌上电脑里。
Microsoft Mail——邮件客户端（包含在Office的老版本中，后来由Microsoft Outlook替代）。
Microsoft Outlook Express——邮件客户端（包含在Office 98 Macintosh版中，后来由Microsoft Entourage替代）。
Microsoft Entourage——邮件客户端（包含在Office 2008及之前版本中，后来由Microsoft Outlook for Mac替代）。
PowerPoint
主条目：Microsoft PowerPoint
Microsoft PowerPoint是一个在Windows和Macintosh下流行的介绍程序。它可以创建由文字组合，图片，电影以及其它事物组成的幻灯片。幻灯片可以在屏幕上显示，并且可以通过阐述者操控，幻灯片也可以使用反映机或投影仪投射到屏幕上。Windows Mobile 2005（Magneto）将使用本程序在市场上拥有统治地位。它的主要竞争者是OpenOffice.org Impress，CorelWord Perfect和AppleKeynote。
Access
主条目：Microsoft Access
Microsoft Access是由微软发布的关联式数据库管理系统。它可以用于制作处理数据的桌面系统。它也常被用来开发简单的网页应用程序。（只提供 Windows 版本）

附带的程序
Microsoft Internet Explorer常用的网络浏览器。现在Internet Explorer不绑捆附带于 Office 中，在 Windows 10 中保留兼容性。
Microsoft Photo Editor——在更旧的版本和XP版的Office中的照片编辑/纲板图形软件。它由Microsoft PhotoDraw暂时地补充在了Office 2000 Premium版中。
Microsoft Office Picture Manager——基本的照片管理软件（与一个基本版的Google的Picasa或Adobe的Photoshop Elements相似）。

高级版本包含的其它程序
Microsoft FrontPage——网站设计软件（并且需要它自己的服务器程序）。对于2003版，它包含在Microsoft Office Professional Edition 2003和Microsoft Office Professional Enterprise Edition之中。它并不包含在Microsoft Office System 2007中，取而代之的是另外发布的Microsoft Expression产品线。
Microsoft Visio——作图程序（单独购买）。
Microsoft Publisher——桌面出版软件。对于2016版，它包含在Microsoft Office Small Business Edition 2007、Microsoft Office Professional (Plus) Edition 2007、Microsoft Office Enterprise Edition 2007和Microsoft Office Professional (Plus) Edition 2010里面。
Microsoft Project——计划管理器（单独购买）。
Microsoft OneNote——笔记软件，适和于使用平板电脑和一般个人计算机。它包含在Microsoft Office System 2016里面。
Microsoft SharePoint Designer——WYSIWYG（所见即所得）html编辑器暨Microsoft通用网页设计程序，用于替代Microsoft Office FrontPage.
Microsoft InfoPath——使用户设计rich XML-based的形式的应用。包含在Microsoft Office Professional Plus Edition 2016、Microsoft Office Enterprise Edition 2007和Microsoft Office Professional Plus Edition 2010之中。
Live Communication Server——实时通信软件。

其他程序
Microsoft Binder——把多个文件合并为一个文件。
Binder对微软来说是一个大规模的失败，并且普及程度很低。因此Office的新版本经常没有这个软件。
Microsoft Entourage——仅用于Macintosh的个人信息管理程序和电子邮件软件。（与Outlook类似）。
Microsoft MapPoint——绘图和旅行计划软件。（自2016版开始作为Excel的组件附赠）
Microsoft Office Communicator 2005-[1]
Developer Tools——开发工具（只包含于开发版）

插件
Office插件
2007 Microsoft Office加载项：将Microsoft文件存储成PDF或XPS：运用该加载项在八种2007 Microsoft Office程序中导出文件，并存为PDF和XPS格式，而无须借助第三方软件。
第三方插件支持
Office应用程序的一个主要特性是用户和第三方业者可以编写以COM为基础的Office包，来扩充应用程序的功能，以及新增自定义的命令和界面。

基于互联网的服务
Microsoft Office Website——网站。包含在Microsoft Office 2007、Microsoft Office 2010的所有版本。 -[2]
Microsoft Office Update——网站。Office2000、XP、2003和2007版、2010版的补丁查找和安装服务。 -[3]
Microsoft AutoUpdate- 供Mac 版本用户更新 Office 至最新版本的安装器
从1997年版本开始，Microsoft Agent（在9.0/2000版和更高版本）和一个相似的演员技术（在8.0/97版）开始提供Office助手，一个交互式帮助工具。“助手”的绰号经常是“Clippy”或“Clippit”。因为它缺省对应CLIPPIT.ACS。
从Macintosh Office 1998开始，Office的Macintosh版本和视窗版本分享同样的文件格式。结果，任意一个安装Office 1998或更晚版本的Macintosh均能读取Windows平台的Office 8.0（1997）版或更晚版本的文件，而且反之亦然。 [

Excel vba 忘了密码 怎么办

1、首先，如果文件格式是Excel 2010版（.xslm），需要先打开Excel文件，另存为2003版格式（.xls）。

2、然后用普通的文本编辑器（这里用的是NotePad++）打开这个文件，注意文件类型选“所有文件”。

3、然后在文件里查找“DPB"，把它改成“DPx”。注意大小写。

4、保存修改。然后用Excel重新打开这个文件。你会遇到一些错误，忽略它们。

5、然后进入Excel的“开发工具”面板，选择“Visual Basic”。又会有一系列错误，忽略它们，知道VBA项目打开。

6、这时候已经可以查看VBA代码了。如果想改变甚至去除原来的密码，继续看。从VBA编辑器的“工具”菜单，选择“VBA工程属性...“，然后转到”保护“面板。

7、在密码框中输入新密码。保存VBA文件和Excel文件，关闭Excel。重新启动Excel并重新打开这个文件，然后进入"开发工具"->"Visual Basic"，会提示输入密码。输入新设置的密码。

8、然后回到VBA编辑器的“工具”->"VBA工程属性"->“保护”，去掉密码以及保护选项前面的标记。最后保存文件即可。

参考技术A 破解vbaproject密码
1． 打开带密码的Excel,视图---宏----录制宏---（保存到）“个人宏工作簿”---点“确认”。
2． 查看宏----点“编辑”-----进入“Microsofe visual basic-PERSONAL.XLSB”页面；
3． 点“模块1“，弹出“模块1代码”----清除“模块1代码”里面的东西-----复制如下东西：
Public Sub 工作表保护密码破解()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"作者:McCormick JE McGimpsey "
Const HEADER As String = "工作表保护密码破解"
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1"
Const REPBACK As String = DBLSPACE & ""
Const ZHENGLI As String = DBLSPACE & " hfhzi3—戊冥 整理"
Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _
& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！"
Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"
Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"
Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!"
Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除"
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _
"如果该文件工作表有不同密码,将搜索下一组密码并解除"
Const MSGONLYONE As String = "确保为唯一的?"
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
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
.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)
If .ProtectStructure = False And _
.ProtectWindows = False Then
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(MSGPWORDFOUND1, _
"$$", PWord1), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If

If WinTag And Not ShTag Then
MsgBox MSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next

For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
'Checks for all clear ShTag triggered to 1 if not.
ShTag = ShTag Or w1.ProtectContents
Next w1
If ShTag Then
For Each w1 In Worksheets
With w1
If .ProtectContents Then
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
.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)
If Not .ProtectContents Then
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
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do 'Bypass all for...nexts
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
End With
Next w1
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER
End Sub
4． 点保存，然后关闭“BOOK1”
5． 点运行即可。 参考技术B

将你要破解的Excel文件关闭，切记一定要关闭呀！然后新建一个Excel文件，打开新建的这个Excel，按下alt+F11，打开vba界面，新建一个模块，将代码复制到这个模块中，代码如下：

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

然后运行该宏，你会看到，打开了一个文件夹，找到我们要破解的这个文件，然后点击打开，稍等几分钟你就会看到破解成功的提示了。

参考技术C 1、Excel版本是office2003及以下可以用工具来破解
2、Excel版本是office2003以上没有任何办法来解决 参考技术D 本回答被提问者采纳