| 网站首页 | 小学教案 | 小学课件 | 小学试卷 | 初中教案 | 初中课件 | 初中试卷 | 高中教案 | 高中课件 | 高中试卷 | 选修课程 | 教师考试 | 心理班会 | 素材 | Map | 
师友资源网: 本站域名www.freezl.net,提供自幼儿园到高中各科各类资源免注册高速免费下载。 设为首页 | 加入收藏 |
您现在的位置: 师友资源网 >> 教师园地 >> 教师博览 >> 正文

破解EXCEL电子表格保护密码的宏源代码下载(亲测有效)         ★★★
破解EXCEL电子表格保护密码的宏源代码下载(亲测有效)
作者:佚名 文章来源:互联网 点击数: 更新时间:2019/2/2 14:20:17

有些电子表格有权限限制,不知道密码就不能编辑修改,怎么办?

电子表格保护密码忘记了,怎么办?

这么办!

适用版本:EXCEL2007-2016

操作方法:

1.打开需要去除密码保护的电子表格,录制一个空白宏;

2.编辑该宏,把里面的代码全部删除;

3.复制粘贴下面的代码到宏里;

4.运行该宏,会破解出保护密码,也可以把电子表格另外保存,无密码保护;

5.注意:源代码不要修改,不要有空行

【源代码如下,也可以到文末下载】


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
.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, vbInformation, HEADER
End Sub

【源代码结束】


源代码下载:

破解EXCEL电子表格保护密码的宏源代码下载

  • 上一篇文章:

  • 下一篇文章:
  • 文章录入:freezl.net    责任编辑:ad2min 
      相同专题信息
    推荐文章 北师大版小学数学二年级上册第一单元加与减第三课时星星合唱队教案设计附教学反思
    推荐文章 最新小学数学二年级《填数游戏》精品教案教学设计
    推荐文章 Linux最好的发行版Centos常用基本命令分享含说明
    推荐文章 杭州幼儿园小班音乐游戏《猫和老鼠》活动教案教学设计
    普通文章 杭州幼儿园中班美术领域《快乐的班级树》活动教案教学设计
    推荐文章 杭州幼儿园大班美术领域《会变的嘴巴》活动教案教学设计
    推荐文章 破解EXCEL电子表格保护密码的宏源代码下载(亲测有效)
    普通文章 教发函〔2019〕1号:教育部 住房和城乡建设部关于印发《幼儿园标准设计样图》的通知(附PDF文档下载)
    推荐文章 教技〔2018〕16号:教育部关于加强网络学习空间建设与应用的指导意见(全文)
    推荐文章 国办发〔2019〕2号:国务院办公厅关于印发国家组织药品集中采购和使用试点方案的通知(全文附解读)
    推荐文章 教高厅〔2018〕4号:教育部办公厅关于印发《教育部高等学校教学指导委员会章程》的通知(全文)
    推荐文章 《个人所得税赡养老人专项扣除指定分摊协议书》(两套模板)
    普通文章 在交流中发展,在开放中复兴
    推荐文章 国办发〔2018〕123号:国务院办公厅关于推进政务新媒体健康有序发展的意见(全文)
    推荐文章 国办发〔2018〕124号:国务院办公厅关于印发文化体制改革中经营性文化事业单位转制为企业和进一步支持文化企业发展两个规定的通知…
    推荐文章 《国务院关于印发个人所得税专项附加扣除暂行办法的通知》(全文附解读图解)
    推荐文章 《中华人民共和国个人所得税法实施条例》(新修订自2019年1月1日起施行)
    推荐文章 国办发〔2018〕121号:国务院办公厅关于加快发展体育竞赛表演产业的指导意见(全文)
    推荐文章 国办发明电〔2018〕15号:国务院办公厅关于2019年部分节假日安排的通知(全文附图解)
    推荐文章 国发〔2018〕39号:国务院关于做好当前和今后一个时期促进就业工作的若干意见(全文)

      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    中职计算机应用基础《轻松玩转大数据》公开课…
    县政府机关部门(局级)网络与信息安全应急预…
    2017年福建省中小学新任教师公开招聘考试中学…
    2017年福建省中小学新任教师公开招聘考试小学…
    《破解中国经济发展之谜(作者: 蔡昉)》(PD…
    | 设为首页 | 加入收藏 | 联系站长 | 友情链接 | 版权申明 | 管理登录 | 
    师友资源网| | 免费教学资源高速下载|浙ICP备17044199号-1