1、工作表写入保护，忘记密码，解决办法：
流程如下：
1打开文件2工具---宏----录制新宏---输入名字如:aa3停止录制(这样得到一个空宏)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
2、office2007怎样添加开发工具选项卡
时间： 2024-12-30 03:49:27