|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
得用VBA才能解决问题了
Sub 解除所有工作表密码和工作簿密码()
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 Pass As String
Dim ShTag As Boolean, WinTag As Boolean
Dim data As New DataObject
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 "当前工作簿没有工作表密码及工作簿密码", 65, "提示"
Exit Sub
End If
MsgBox "根据电脑硬件不同，可能需要一到三分钟,请等候。", 65, "提示"
If Not WinTag Then
MsgBox "没有工作簿密码，现在开始破解工作表密码！", 65, "提示"
Else
On Error Resume Next
Do
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
Pass = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
data.SetText Pass
data.PutInClipboard
MsgBox "工作簿保护密码:" & Pass & Chr(10) & "已复制到剪贴板,请以后记得备份您的密码", vbInformation, "提示"
Exit Do
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 "没有工作表密码，现在开始破解工作簿密码！", 65, "提示"
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
w1.Unprotect Pass
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
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
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
Pass = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
data.SetText Pass
data.PutInClipboard
MsgBox w1.Name & "密码为：" & Pass & Chr(10) & "已复制到剪贴板,请以后记得备份您的密码", 65, "提示"
For Each w2 In Worksheets
w2.Unprotect Pass
Next w2
Exit Do
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
End Sub
[ 本帖最后由 sachengbao 于 2010-12-19 10:43 编辑 ] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-12-19 09:17
楼主
