1、工作表写入保护,忘记密码,解决办法:
流程如下:
1打开文件
2工具---宏----录制新宏---输入名字如:aa
3停止录制(这样得到一个空宏)
4工具---宏----宏,选aa,点编辑按钮
5删除窗口中的所有字符(只有几个),替换为下面的内容:
1 Public Sub AllInternalPasswords() 2 ' Breaks worksheet and workbook structure passwords. Bob McCormick 3 ' probably originator of base code algorithm modified for coverage 4 ' of workbook structure / windows passwords and for multiple passwords 5 ' 6 ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 7 ' Modified 2003-Apr-04 by JEM: All msgs to constants, and 8 ' eliminate one Exit Sub (Version 1.1.1) 9 ' Reveals hashed passwords NOT original passwords 10 Const DBLSPACE As String = vbNewLine & vbNewLine 11 Const AUTHORS As String = DBLSPACE & vbNewLine & _ 12 "Adapted from Bob McCormick base code by" & _ 13 "Norman Harker and JE McGimpsey" 14 Const HEADER As String = "AllInternalPasswords User Message" 15 Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" 16 Const REPBACK As String = DBLSPACE & "Please report failure " & _ 17 "to the microsoft.public.excel.programming newsgroup." 18 Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ 19 "now be free of all password protection, so make sure you:" & _ 20 DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ 21 DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 22 DBLSPACE & "Also, remember that the password was " & _ 23 "put there for a reason. Don't stuff up crucial formulas " & _ 24 "or data." & DBLSPACE & "Access and use of some data " & _ 25 "may be an offense. If in doubt, don't." 26 Const MSGNOPWORDS1 As String = "There were no passwords on " & _ 27 "sheets, or workbook structure or windows." & AUTHORS & VERSION 28 Const MSGNOPWORDS2 As String = "There was no protection to " & _ 29 "workbook structure or windows." & DBLSPACE & _ 30 "Proceeding to unprotect sheets." & AUTHORS & VERSION 31 Const MSGTAKETIME As String = "After pressing OK button this " & _ 32 "will take some time." & DBLSPACE & "Amount of time " & _ 33 "depends on how many different passwords, the " & _ 34 "passwords, and your computer's specification." & DBLSPACE & _ 35 "Just be patient! Make me a coffee!" & AUTHORS & VERSION 36 Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ 37 "Structure or Windows Password set." & DBLSPACE & _ 38 "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 39 "Note it down for potential future use in other workbooks by " & _ 40 "the same person who set this password." & DBLSPACE & _ 41 "Now to check and clear other passwords." & AUTHORS & VERSION 42 Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 43 "password set." & DBLSPACE & "The password found was: " & _ 44 DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 45 "future use in other workbooks by same person who " & _ 46 "set this password." & DBLSPACE & "Now to check and clear " & _ 47 "other passwords." & AUTHORS & VERSION 48 Const MSGONLYONE As String = "Only structure / windows " & _ 49 "protected with the password that was just found." & _ 50 ALLCLEAR & AUTHORS & VERSION & REPBACK 51 Dim w1 As Worksheet, w2 As Worksheet 52 Dim i As Integer, j As Integer, k As Integer, l As Integer 53 Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer 54 Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 55 Dim PWord1 As String 56 Dim ShTag As Boolean, WinTag As Boolean 57 Application.ScreenUpdating = False 58 With ActiveWorkbook 59 WinTag = .ProtectStructure Or .ProtectWindows 60 End With 61 ShTag = False 62 For Each w1 In Worksheets 63 ShTag = ShTag Or w1.ProtectContents 64 Next w1 65 If Not ShTag And Not WinTag Then 66 MsgBox MSGNOPWORDS1, vbInformation, HEADER 67 Exit Sub 68 End If 69 MsgBox MSGTAKETIME, vbInformation, HEADER 70 If Not WinTag Then 71 MsgBox MSGNOPWORDS2, vbInformation, HEADER 72 Else 73 On Error Resume Next 74 Do 'dummy do loop 75 For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 76 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 77 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 78 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 79 With ActiveWorkbook 80 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ 81 Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ 82 Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 83 If .ProtectStructure = False And _ 84 .ProtectWindows = False Then 85 PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 86 Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 87 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 88 MsgBox Application.Substitute(MSGPWORDFOUND1, _ 89 "$$", PWord1), vbInformation, HEADER 90 Exit Do 'Bypass all for...nexts 91 End If 92 End With 93 Next: Next: Next: Next: Next: Next 94 Next: Next: Next: Next: Next: Next 95 Loop Until True 96 On Error GoTo 0 97 End If 98 If WinTag And Not ShTag Then 99 MsgBox MSGONLYONE, vbInformation, HEADER 100 Exit Sub 101 End If 102 On Error Resume Next 103 For Each w1 In Worksheets 104 'Attempt clearance with PWord1 105 w1.Unprotect PWord1 106 Next w1 107 On Error GoTo 0 108 ShTag = False 109 For Each w1 In Worksheets 110 'Checks for all clear ShTag triggered to 1 if not. 111 ShTag = ShTag Or w1.ProtectContents 112 Next w1 113 If ShTag Then 114 For Each w1 In Worksheets 115 With w1 116 If .ProtectContents Then 117 On Error Resume Next 118 Do 'Dummy do loop 119 For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 120 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 121 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 122 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 123 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ 124 Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 125 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 126 If Not .ProtectContents Then 127 PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 128 Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 129 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 130 MsgBox Application.Substitute(MSGPWORDFOUND2, _ 131 "$$", PWord1), vbInformation, HEADER 132 'leverage finding Pword by trying on other sheets 133 For Each w2 In Worksheets 134 w2.Unprotect PWord1 135 Next w2 136 Exit Do 'Bypass all for...nexts 137 End If 138 Next: Next: Next: Next: Next: Next 139 Next: Next: Next: Next: Next: Next 140 Loop Until True 141 On Error GoTo 0 142 End If 143 End With 144 Next w1 145 End If 146 MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 147 End Sub
或者参考如下内容:
是打开文件需要密码?还是文件打开后设置的修改密码?他们方法不同的,我都用过。(符件中的移除密码,是移除打开文件时需要的密码,无需安装,打开即用,很简单。),如果是能
打开文件,需要取消单元格的修改密码,方法如下:
先打开EXCEL文件,然后点“录制宏”,随便录一下就可以了,然后打开“宏”选“编辑”,将里面的内容全部换成以下文本,然后执行。几分钟后,即可解掉密码。
1 Option Explicit 2 3 Public Sub AllInternalPasswords() 4 ' Breaks worksheet and workbook structure passwords. Bob McCormick 5 ' probably originator of base code algorithm modified for coverage 6 ' of workbook structure / windows passwords and for multiple passwords 7 ' 8 ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 9 ' Modified 2003-Apr-04 by JEM: All msgs to constants, and 10 ' eliminate one Exit Sub (Version 1.1.1) 11 ' Reveals hashed passwords NOT original passwords 12 Const DBLSPACE As String = vbNewLine & vbNewLine 13 Const AUTHORS As String = DBLSPACE & vbNewLine & _ 14 "Adapted from Bob McCormick base code by" & _ 15 "Norman Harker and JE McGimpsey" 16 Const HEADER As String = "AllInternalPasswords User Message" 17 Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" 18 Const REPBACK As String = DBLSPACE & "Please report failure " & _ 19 "to the microsoft.public.excel.programming newsgroup." 20 Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ 21 "now be free of all password protection, so make sure you:" & _ 22 DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ 23 DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 24 DBLSPACE & "Also, remember that the password was " & _ 25 "put there for a reason. Don't stuff up crucial formulas " & _ 26 "or data." & DBLSPACE & "Access and use of some data " & _ 27 "may be an offense. If in doubt, don't." 28 Const MSGNOPWORDS1 As String = "There were no passwords on " & _ 29 "sheets, or workbook structure or windows." & AUTHORS & VERSION 30 Const MSGNOPWORDS2 As String = "There was no protection to " & _ 31 "workbook structure or windows." & DBLSPACE & _ 32 "Proceeding to unprotect sheets." & AUTHORS & VERSION 33 Const MSGTAKETIME As String = "After pressing OK button this " & _ 34 "will take some time." & DBLSPACE & "Amount of time " & _ 35 "depends on how many different passwords, the " & _ 36 "passwords, and your computer's specification." & DBLSPACE & _ 37 "Just be patient! Make me a coffee!" & AUTHORS & VERSION 38 Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ 39 "Structure or Windows Password set." & DBLSPACE & _ 40 "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 41 "Note it down for potential future use in other workbooks by " & _ 42 "the same person who set this password." & DBLSPACE & _ 43 "Now to check and clear other passwords." & AUTHORS & VERSION 44 Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 45 "password set." & DBLSPACE & "The password found was: " & _ 46 DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 47 "future use in other workbooks by same person who " & _ 48 "set this password." & DBLSPACE & "Now to check and clear " & _ 49 "other passwords." & AUTHORS & VERSION 50 Const MSGONLYONE As String = "Only structure / windows " & _ 51 "protected with the password that was just found." & _ 52 ALLCLEAR & AUTHORS & VERSION & REPBACK 53 54 Dim w1 As Worksheet, w2 As Worksheet 55 Dim i As Integer, j As Integer, k As Integer, l As Integer 56 Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer 57 Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 58 Dim PWord1 As String 59 Dim ShTag As Boolean, WinTag As Boolean 60 61 Application.ScreenUpdating = False 62 With ActiveWorkbook 63 WinTag = .ProtectStructure Or .ProtectWindows 64 End With 65 ShTag = False 66 For Each w1 In Worksheets 67 ShTag = ShTag Or w1.ProtectContents 68 Next w1 69 If Not ShTag And Not WinTag Then 70 MsgBox MSGNOPWORDS1, vbInformation, HEADER 71 Exit Sub 72 End If 73 MsgBox MSGTAKETIME, vbInformation, HEADER 74 If Not WinTag Then 75 MsgBox MSGNOPWORDS2, vbInformation, HEADER 76 Else 77 On Error Resume Next 78 Do 'dummy do loop 79 For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 80 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 81 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 82 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 83 With ActiveWorkbook 84 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ 85 Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ 86 Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 87 If .ProtectStructure = False And _ 88 .ProtectWindows = False Then 89 PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 90 Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 91 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 92 MsgBox Application.Substitute(MSGPWORDFOUND1, _ 93 "$$", PWord1), vbInformation, HEADER 94 Exit Do 'Bypass all for...nexts 95 End If 96 End With 97 Next: Next: Next: Next: Next: Next 98 Next: Next: Next: Next: Next: Next 99 Loop Until True 100 On Error GoTo 0 101 End If 102 If WinTag And Not ShTag Then 103 MsgBox MSGONLYONE, vbInformation, HEADER 104 Exit Sub 105 End If 106 On Error Resume Next 107 For Each w1 In Worksheets 108 'Attempt clearance with PWord1 109 w1.Unprotect PWord1 110 Next w1 111 On Error GoTo 0 112 ShTag = False 113 For Each w1 In Worksheets 114 'Checks for all clear ShTag triggered to 1 if not. 115 ShTag = ShTag Or w1.ProtectContents 116 Next w1 117 If ShTag Then 118 For Each w1 In Worksheets 119 With w1 120 If .ProtectContents Then 121 On Error Resume Next 122 Do 'Dummy do loop 123 For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 124 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 125 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 126 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 127 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ 128 Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 129 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 130 If Not .ProtectContents Then 131 PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 132 Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 133 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 134 MsgBox Application.Substitute(MSGPWORDFOUND2, _ 135 "$$", PWord1), vbInformation, HEADER 136 'leverage finding Pword by trying on other sheets 137 For Each w2 In Worksheets 138 w2.Unprotect PWord1 139 Next w2 140 Exit Do 'Bypass all for...nexts 141 End If 142 Next: Next: Next: Next: Next: Next 143 Next: Next: Next: Next: Next: Next 144 Loop Until True 145 On Error GoTo 0 146 End If 147 End With 148 Next w1 149 End If 150 MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 151 End Sub
2、office2007怎样添加开发工具选项卡