已阅读5页,还剩5页未读, 继续免费阅读
版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
用宏代码-破解工作表保护密码(VBAproject密码破解,很好用)网上有很多这个代码,但很多朋友并不太了解如何运用在此做了一些整理,希望对大家有所帮助!注:很多时候会因为忘记密码丢失重要EXCEL文件而烦恼,这份代码就能帮你找回,仅仅出之这个初衷,如因为这个代码让你感到不安全,那请加强电脑文件的密保,如用在不当的地方,后果自负!工作表保护密码破解(图解)1、新建一个EXCEL文件“BOOK1”, 在工具栏空白位置,任意右击,选择Visual Basic项, 弹出Visual Basic工具栏:2、在Visual Basic工具栏中,点击“录制”按钮, 弹出“录制新宏”对话框,选择“个人宏工作簿”:3、选择“个人宏工作簿”后按确定, 弹出如下“暂停”按钮,点击停止:4、在Visual Basic工具栏中,点击“编辑”按钮:5、点击“编辑”按钮后,弹出如下图的编辑界面: 找到“VBAProject(PERSONAL.XLS)模块模块1(也可能是模块N-其他数字)” 双击模块1将右边代码内容清空6、复制“工作保护密码破解”代码到右边框中,点保存,然后关闭“BOOK1”7、运行需要解密的“EXCEL文件”,在Visual Basic工具栏中,点击“运行”按钮8、点击“运行”按钮后,弹出“宏”对话框, 点击运行“PERSONAL.XLS!工作保护密码破解”这个宏9、运行“PERSONAL.XLS!工作保护密码破解”这个宏后, 如下图示意就可以 解除工作表的密码保护了(这个图,如果工作表中有多组不同密码, 每解开一组,就会提示一次,也就说可能会出现几次)工作表保护密码破解(代码)=请复制以下内容=Public Sub 工作表保护密码破解()Const DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _作者:McCormick JE McGimpsey Const HEADER As String = 工作表保护密码破解Const VERSION As String = DBLSPACE & 版本 Version 1.1.1Const 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 = 该文件工作表中没有加密2Const 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 WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenElseOn Error Resume NextDo dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126With 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 ThenPWord1 = 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, HEADERExit Do Bypass all for.nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In WorksheetsAttempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In WorksheetsChecks for all clear ShTag triggered to 1 if not.ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For 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 ThenPWord1 = 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, HEADERleverage finding Pword by trying on other sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do Bypass all for.nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: N
温馨提示
- 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
- 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
- 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
- 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
- 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
- 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
- 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 内蒙古呼伦贝尔市2025年生物高二上期末调研模拟试题含解析
- 上海市进才实验中学2026届化学高二上期末考试模拟试题含解析
- 阜阳师范大学信息工程学院《语言基础知识教学论》2024-2025学年第一学期期末试卷
- 法律服务的市场分析
- 小区物业保洁主管目标责任书
- 北京工业大学本科生毕业设计(论文)撰写规范-2025
- 电力行业存在的困难及其解决对策
- 新版全国计算机等级考试二级MSoffice选择题题库
- 硕士研究生毕业论文开题报告写作技巧及范文
- 【毕业论文】物流管理专业毕业论文连锁超市配送线路优化研究
- 2025年消防安全知识答题库(附答案)
- 喷漆外包管理办法
- 稽留流产的课件
- 租车挂靠协议书
- 人民医院改扩建建设项目水土保持方案
- 绿色插画风小蝌蚪找妈妈绘本故事
- 官兵心理健康教育
- 公务员职业生涯发展课件
- GB/T 192-2025普通螺纹牙型
- CRRT授权管理制度
- 2025-2030中国电缆敷设船行业市场发展趋势与前景展望战略研究报告
评论
0/150
提交评论