[转]Excel 工作表保护密码移除
Public Sub 工作表保护密码()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"作者:eric"
Const HEADER As String = "工作表保护密码"
Const VERSION As String = DBLSPACE & "版本 Version 1.1.1"
Const REPBACK As String = DBLSPACE & ""
Const ZHENGLI As String = DBLSPACE & " eric"
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 = To : For j = To : For k = To
For l = To : For m = To : For i1 = To
For i2 = To : For i3 = To : For i4 = To
For i5 = To : For i6 = To : For n = To
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
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
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 = To : For j = To : For k = To
For l = To : For m = To : For i1 = To
For i2 = To : For i3 = To : For i4 = To
For i5 = To : For i6 = To : For n = To
.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
End If
End With
Next w1
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER
End Sub
[转]Excel 工作表保护密码移除的更多相关文章
- 破解EXCEL工作表保护密码
神技 破解EXCEL工作表保护密码 http://www.mr-wu.cn/crack-excel-workbook-protection/ 我们可以通过新建工作本,来创建一个新的工作本来创造新的宏而 ...
- 方法一破解:Excel工作表保护密码
在excel2016中实测验证过有效 在Excel中,为了保护自已的工作表不被修改,我们可以添加保护密码. 操作步骤: 1.把Excel文件的扩展名xlsx修改为Rar.瞬间Excel文件变成了压缩包 ...
- 方法二破解:Excel工作表保护密码
最简单,复制整表,粘贴在全新的表中.但是有时候会丢失一些元素 在excel2016中实测验证过有效 第1步:在工作表菜单栏上添加[开发工具].方法是:依次单击[文件]--->[选项]---> ...
- EXCEL工作表保护密码忘记了,如何撤消工作表保护?
按下面步骤操作,如果不会发邮件给我吧 SamRichard@live.cn 1\打开文件 2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 4\工具---宏-- ...
- 方法三破解:Excel工作表保护密码
Sub PasswordBreaker() Dim i As Integer, j As Integer, k As Integer Dim l As Integer, m As Integer, ...
- Excel—“撤销工作表保护密码”的破解并获取原始密码
您是否遇到过这样的情况:您用Excel编制的报表.表格.程序等,在单元格中设置了公式.函数等,为了防止其他人修改您的设置或者防止您自己无意中修改,您可能会使用Excel的工作表保护功能,但时间久了保护 ...
- 转:Excel—“撤销工作表保护密码”的破解并获取原始密码
在日常工作中,您是否遇到过这样的情况:您用Excel编制的报表.表格.程序等,在单元格中设置了公式.函数等,为了防止其他人修改您的设置或者防止您自己无意中修改,您可能会使用Excel的工作表保护功能, ...
- EXCEL密码破解/破解工作表保护密码
网上有很多这个代码,但很多朋友并不太了解如何运用在此做了一些整理,希望对大家有所帮助! 注:很多时候会因为忘记密码丢失重要EXCEL文件而烦恼,这份代码就能帮你找回,仅仅出之这个初衷,如因为这个代码让 ...
- Excel工作表保护的密码破解与清除...假装自己破解密码系列?
有一次我女朋友让我帮忙解一个excel表格的保护密码,然后~用了宏 网上下载来的Excel经常会有工作表保护,也就是无法修改,妄图做任何修改的时候你就会看见这句话: 您试图更改的单元格或图表位于受保护 ...
随机推荐
- DevExpress XtraScheduler日程管理控件应用实例(2)-- 深入理解数据存储
DevExpress年终击穿底价,单套授权低至67折!查看详情>>> 在上篇随笔<DevExpress XtraScheduler日程管理控件应用实例(1)-- 基本使用> ...
- 写在连载之前——DIY微型操作系统篇
这个博客开了这么久都没写过什么东西.可能是因为我想写的东西在网上都能找得到,所以自己也懒得去写了. 但是这次当我在看<30天自制操作系统>这本书的时候发现,如果不用作者原版的光盘软件,要自 ...
- GSM中时隙、信道、突发序列、帧的解释
刚从论坛中看到有人问GSM中时隙.信道.突发序列.帧知识.今天我们数字通信正好上到这一块,我就根据我知道的和网上搜索的回答! 1.时分多路复用技术 FDMA:频分多址 TDMA:时分多址 CDMA:码 ...
- 解决在转发一条内容为满的彩信,删除主题FWD,发送的时候提示转化为短信。
问题描述: 1.长按一条输入内容为满的彩信,选择转发 2.输入联系人-删除主题FWD-发送 测试结果为:提示正转化为短信(见附件) 预期结果为:不应该有提示,应该还是彩信 测试结果图为: 根据提示的T ...
- springboot跨域请求
首页 所有文章 资讯 Web 架构 基础技术 书籍 教程 Java小组 工具资源 SpringBoot | 番外:使用小技巧合集 2018/09/17 | 分类: 基础技术 | 0 条评论 | 标 ...
- 阿里java面试题
引言 其实本来真的没打算写这篇文章,主要是LZ得记忆力不是很好,不像一些记忆力强的人,面试完以后,几乎能把自己和面试官的对话都给记下来.LZ自己当初面试完以后,除了记住一些聊过的知识点以外,具体的内容 ...
- 微信小程序之蓝牙开发(详细读数据、写数据、附源码)
本文将详细介绍微信小程序的蓝牙开发流程(附源码)准备:微信只支持低功耗蓝牙也就是蓝牙4.0,普通的蓝牙模块是用不了的,一定要注意. 蓝牙可以连TTL接到电脑上,再用XCOM调试 一开始定义的变量 va ...
- tiny4412 UART for C printf Demo
/************************************************************************** * tiny4412 UART for C pr ...
- 【HDU5421】Victor and String(回文树)
[HDU5421]Victor and String(回文树) 题面 Vjudge 大意: 你需要支持以下操作: 动态在前端插入一个字符 动态在后端插入一个字符 回答当前本质不同的回文串个数 回答当前 ...
- django所遇到问题简单总结
问题虽小,但却值得深思 一.改mysql密码 方法1: 用SET PASSWORD命令 首先登录MySQL. 格式:mysql> set password for 用户名@localhost = ...