excel密码保护

excel密码保护 1、打您需要撤保密的开开开开开开开开开开开Excel文件, 2、依次点菜上的工具开开开开开开开开---宏----开开开开开开开制新宏,入宏名字如:ab, 3、停止制开开(开开得到一个空宏), 4、依次点菜上的工具开开开开开开开开---宏----宏,开ab,点按,开开开开开 5、除窗口中的所有字符开开开开开开开开开开(只有几个),替以下内容,开开开开开开开 Public Sub 工作保密开开开() Const DBLSPACE As String = vbNewLine & vbNewLineConst 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 IntegerDim 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 .ProtectWindowsEnd 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, HEADERExit Sub End If MsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag Then Else On Error Resume Next Do 'dummy do loop For 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 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, HEADERExit 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 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 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...nextsEnd If Next: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until True On Error GoTo 0 End If End With Next w1 End If MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER End Sub 6、窗口,开开开开开开开 7、依次点菜上的工具开开开开开开开开---宏-----宏,开AllInternalPasswords,运行,确定两次,等候一两分开,会出以下框:开开开开开开开 开是Excel密的原始密开开开开开开开开(此密和之前置的密均能打此文档。开开开开开开开开开开开开开开开开开