返回目录：excel表格制作
在日常工作中，大家有时会遇到过这样的情况：使用Excel编制的报表、表格等，在单元格中设置了公式、函数等，为了防止其他人修改设置或者防止自己无意中修改，可能会使用Excel的工作表保护功能，但时间久了保护密码容易忘记，这该怎么办？
或者有时您从网上下载的Excel格式的文档，想修改适合自己使用，但是作者加了工作表保护密码，怎么办？
其实只要能打开Excel表到只读状态，您只要按照以下步骤操作，Excel工作表保护密码点到即破！
方法/步骤：（以Excel2007为例）
1. 打开您需要破解的Excel文件，如图所示：
2. 依次点击菜单栏上的【视图】-【宏】-【录制宏】；
3.根据自己喜好输入宏名字（动作徒劳，因为后续会删除，不过还是得先给它个名字），或者默认Macro1，点击确定，然后停止录制(这样得到一个空宏，为后面添加vb代码做准备)；
4. 依次点击菜单栏上的【视图】-【宏】-【查看宏】，选择刚才录制的宏，点编辑按钮；删除窗口中的所有字符，替换为下面的内容；
或者跳过步骤2，3，在步骤1之后，直接按Alt+F11，直接进入VBE窗口，录入以下内容：
OptionExplicit
Public SubAllInternalPasswords()
ConstDBLSPACE As String = vbNewLine & vbNewLine
Const HEADERAs String = "所有内部用户的密码信息"
Const VERSIONAs String = DBLSPACE & "Version 1.0 2019-Apr-08"
ConstALLCLEAR As String = DBLSPACE & "这文档" & _
"现在所有密码保护已经破解，所以一定要：" & _
DBLSPACE& "现在就保存！" &DBLSPACE & "同样"& _
DBLSPACE& "备份！备份！！备份！！！"& _
DBLSPACE& "要记住密码设置是有原因的。"& _
"别擅自修改关键公式或数据。" & DBLSPACE & "某些数据的访问和使用可能是一种犯罪。" & _
"如果不确定，请不要破解！"
ConstMSGNOPWORDS1 As String = "工作表或工作簿结构和窗口已经没有密码保护" & VERSION
ConstMSGNOPWORDS2 As String = "工作表或工作簿结构和窗口已经没有密码保护" & DBLSPACE & "继续取消表格保护." & _
VERSION
ConstMSGTAKETIME As String = " 在按下OK按钮之后，这将需要一些时间。" & DBLSPACE & "时间量" & _
"取决于密码设置难度,和您的计算机的性能" &DBLSPACE & _
"耐心点！" & VERSION
ConstMSGPWORDFOUND1 As String = "你有一个工作表结构或窗口密码设置为" & DBLSPACE & "$$" & DBLSPACE & _
"记录下来，这个密码可能在其他工作簿中使用" & DBLSPACE & _
"现在，检查并清除其他密码。" & VERSION
ConstMSGPWORDFOUND2 As String = "你有一个工作表结构或窗口密码设置为" & _
DBLSPACE& "$$" & DBLSPACE & "记录下来，这个密码可能在其他工作簿中使用。" & DBLSPACE & "现在，检查并清除其他密码。" & VERSION
ConstMSGONLYONE As String = "只发现结构/窗户有密码保护" & _
ALLCLEAR& VERSION
Dim w1 AsWorksheet, w2 As Worksheet
Dim i AsInteger, j As Integer, k As Integer, l As Integer
Dim m AsInteger, n As Integer, i1 As Integer, i2 As Integer
Dim i3 AsInteger, i4 As Integer, i5 As Integer, i6 As Integer
Dim PWord1 AsString
Dim ShTag AsBoolean, WinTag As Boolean
Application.ScreenUpdating= False
WithActiveWorkbook
WinTag =.ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1In Worksheets
ShTag = ShTagOr w1.ProtectContents
Next w1
If Not ShTagAnd Not WinTag Then
MsgBoxMSGNOPWORDS1, vbInformation, HEADER
Exit Sub
End If
MsgBoxMSGTAKETIME, vbInformation, HEADER
If Not WinTagThen
MsgBoxMSGNOPWORDS2, vbInformation, HEADER
Else
On ErrorResume Next
Do 'dummy doloop
For i = 65 To66: For j = 65 To 66: For k = 65 To 66
For l = 65 To66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65To 66: For i6 = 65 To 66: For n = 32 To 126
WithActiveWorkbook
.UnprotectChr(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)
MsgBoxApplication.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 UntilTrue
On Error GoTo0
End If
If WinTag AndNot ShTag Then
MsgBoxMSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On ErrorResume Next
For Each w1 InWorksheets
'Attemptclearance with PWord1
w1.UnprotectPWord1
Next w1
On Error GoTo0
ShTag = False
For Each w1In Worksheets
'Checks forall clear ShTag triggered to 1 if not.
ShTag = ShTagOr w1.ProtectContents
Next w1
If ShTag Then
For Each w1In Worksheets
With w1
If.ProtectContents Then
On ErrorResume Next
Do 'Dummy doloop
For i = 65 To66: For j = 65 To 66: For k = 65 To 66
For l = 65 To66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65To 66: For i6 = 65 To 66: For n = 32 To 126
.UnprotectChr(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)
MsgBoxApplication.Substitute(MSGPWORDFOUND2, _
"$$",PWord1), vbInformation, HEADER
'leveragefinding Pword by trying on other sheets
For Each w2In Worksheets
w2.UnprotectPWord1
Next w2
Exit Do'Bypass all for...nexts
End If
Next: Next:Next: Next: Next: Next
Next: Next:Next: Next: Next: Next
Loop UntilTrue
On Error GoTo0
End If
End With
Next w1
End If
MsgBoxALLCLEAR & VERSION, vbInformation, HEADER
End Sub
5.依次点击菜单栏上的【视图】-【宏】-【查看宏】，选AllInternalPasswords，执行，确定两次；耐心等一会，依次点击确定。
如设置了工作表保护则会有如下对话框：
6.Excel已经成功破解密码，可以重置并保存。
注意：设置密码肯定是有原因的，不要随意破解并修改，否则可能带来更多麻烦。
能记住密码最好，不到万不得已，请不要使用！
能记住密码最好，不到万不得已，请不要使用！！
能记住密码最好，不到万不得已，请不要使用！！！