如何解除EXCEL工作表锁定[管理资料]

如何解除EXCEL工作锁定[管理资料] 在日常工作中，大家有时会遇到过这样的情况:使用Excel编制的报表、、程序等，在单元格中设置了公式、函数等，为了防止其他人修改您的设置或者防止您自己无意中修改，您可能会使用Excel的工作表保护功能，但时间久了保护密码容易忘记，这该怎么办,有时您从网上下载的Excel的小程序，您想修改，但是作者加了工作表保护密码，怎么办,您只要按照以下步骤操作，Excel工作表保护密码瞬间(稍微有点夸张)即破～ 工具/原料 , 待破解的Excel工作表 方法/步骤 1. 1 打开您需要破解的Excel文件，如图所示: 2. 2 依次点击菜单栏上的工具---宏----录制新宏; 3. 3 输入宏名字(PS:打击积极性啊～)如:易尔拓，然后停止录制(这样得到一个空宏，为后面添加vb代码做准备); 4. 4 依次点击菜单栏上的工具---宏----宏,选易尔拓,点编辑按钮; 删除窗口中的所有字符,替换为下面的内容; Option Explicit Public Sub llInternlPsswords() ' Breks worksheet nd workbook structure psswords. Bob McCormick ' probbly origintor of bse code lgorithm modified for coverge ' of workbook structure / windows psswords nd for multiple psswords ' ' Normn Hrker nd JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-pr-04 by JEM: ll msgs to constnts, nd ' eliminte one Exit Sub (Version 1.1.1) ' Revels hshed psswords NOT originl psswords Const DBLSPCE s String = vbNewLine & vbNewLine Const UTHORS s String = DBLSPCE & vbNewLine & _ "dpted from Bob McCormick bse code by" & _ "Normn Hrker nd JE McGimpsey" Const HEDER s String = "llInternlPsswords User Messge" Const VERSION s String = DBLSPCE & "Version 1.1.1 2003-pr-04" Const REPBCK s String = DBLSPCE & "Plese report filure " & _ "to the microsoft.public.excel.progrmming newsgroup." Const LLCLER s String = DBLSPCE & "The workbook should " & _ "now be free of ll pssword protection, so mke sure you:" & _ DBLSPCE & "SVE IT NOW!" & DBLSPCE & "nd lso" & _ DBLSPCE & "BCKUP!, BCKUP!!, BCKUP!!!" & _ DBLSPCE & "lso, remember tht the pssword ws " & _ "put there for reson. Don't stuff up crucil formuls " & _ "or dt." & DBLSPCE & "ccess nd use of some dt " & _ "my be n offense. If in doubt, don't." Const MSGNOPWORDS1 s String = "There were no psswords on " & _ "sheets, or workbook structure or windows." & UTHORS & VERSION Const MSGNOPWORDS2 s String = "There ws no protection to " & _ "workbook structure or windows." & DBLSPCE & _ "Proceeding to unprotect sheets." & UTHORS & VERSION Const MSGTKETIME s String = "fter pressing OK button this " & _ "will tke some time." & DBLSPCE & "mount of time " & _ "depends on how mny different psswords, the " & _ "psswords, nd your computer's specifiction." & DBLSPCE & _ "Just be ptient! Mke me coffee!" & UTHORS & VERSION Const MSGPWORDFOUND1 s String = "You hd Worksheet " & _ "Structure or Windows Pssword set." & DBLSPCE & _ "The pssword found ws: " & DBLSPCE & "$$" & DBLSPCE & _ "Note it down for potentil future use in other workbooks by " & _ "the sme person who set this pssword." & DBLSPCE & _ "Now to check nd cler other psswords." & UTHORS & VERSION Const MSGPWORDFOUND2 s String = "You hd Worksheet " & _ "pssword set." & DBLSPCE & "The pssword found ws: " & _ DBLSPCE & "$$" & DBLSPCE & "Note it down for potentil " & _ "future use in other workbooks by sme person who " & _ "set this pssword." & DBLSPCE & "Now to check nd cler " & _ "other psswords." & UTHORS & VERSION Const MSGONLYONE s String = "Only structure / windows " & _ "protected with the pssword tht ws just found." & _ LLCLER & UTHORS & VERSION & REPBCK Dim w1 s Worksheet, w2 s Worksheet Dim i s Integer, j s Integer, k s Integer, l s Integer Dim m s Integer, n s Integer, i1 s Integer, i2 s Integer Dim i3 s Integer, i4 s Integer, i5 s Integer, i6 s Integer Dim PWord1 s String Dim ShTg s Boolen, WinTg s Boolen ppliction.ScreenUpdting = Flse With ctiveWorkbook WinTg = .ProtectStructure Or .ProtectWindows End With ShTg = Flse For Ech w1 In Worksheets ShTg = ShTg Or w1.ProtectContents Next w1 If Not ShTg nd Not WinTg Then MsgBox MSGNOPWORDS1, vbInformtion, HEDER Exit Sub End If MsgBox MSGTKETIME, vbInformtion, HEDER If Not WinTg Then MsgBox MSGNOPWORDS2, vbInformtion, HEDER Else On Error Resume Next Do 'dummy do loop 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 ctiveWorkbook .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 = Flse nd _ .ProtectWindows = Flse 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 ppliction.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformtion, HEDER Exit Do 'Bypss ll 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 WinTg nd Not ShTg Then MsgBox MSGONLYONE, vbInformtion, HEDER Exit Sub End If On Error Resume Next For Ech w1 In Worksheets 'ttempt clernce with PWord1 w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTg = Flse For Ech w1 In Worksheets 'Checks for ll cler ShTg triggered to 1 if not. ShTg = ShTg Or w1.ProtectContents Next w1 If ShTg Then For Ech 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 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 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 ppliction.Substitute(MSGPWORDFOUND2, _ "$$", PWord1), vbInformtion, HEDER 'leverge finding Pword by trying on other sheets For Ech w2 In Worksheets w2.Unprotect PWord1 Next w2 Exit Do 'Bypss ll for...nexts 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 MsgBox LLCLER & UTHORS & VERSION & REPBCK, vbInformtion, HEDER End Sub 5. 5 依次点击菜单栏上的工具---宏-----宏,选llInternlPsswords,执行,确定两次; 耐心等一会,再点击两次确定，就ok啦～ END 原作者:易尔拓