ＥXCEＬ工作表保护密码破解 宏撤销保护图文教程你好， 这是我遇到类似问题时，上网找的如果你遇到类似问题,也可以用以下方法进行处理,在这里感谢作者1新建宏 工具-宏-录制新宏 随便输入个名字如hｏng 点击“确定”按钮 ﻫ2点击“停止录制”按钮或从菜单“停止录制”宏ﻫ３点击工具—宏—宏 选择刚才所建的宏然后点击“编辑”按钮ﻫﻫﻫﻫ4经过以上会弹出代码编写窗口5填写代码将下面的代码全部复制必替换原来的字符,填写完毕后关闭该窗口Public Ｓub 工作表保护密码破解（）ﻫＣoｎsｔ DBLＳＰACＥ Aｓ Sｔrｉng = vｂＮewLiｎe ＆ vbＮewLiｎeﻫCｏnｓt AUTHORS Ａs Strｉng = DBＬSＰＡCE & vbＮeｗLine ＆ _"作者:圣天＂ﻫCｏｎst HEADER Ａｓ Ｓtring ＝ ＂工作表保护密码破解"Ｃｏnst VERSION As String = DBLＳPACE ＆ ＂版本 Ｖersion 11.1"Const ＲＥPＢAＣK As Sｔring ＝ DBLSＰACE & ＂”Cｏnｓt ZHENGLI As String = DBLSPACE & " XXXＸXXX"ﻫＣｏｎst ALＬＣLＥＡＲ As String ＝ ＤBＬSPACE ＆ ”该工作簿中的工作表密码保护已全部解除!!” & DBLＳPＡCＥ & ＂请记得另保存” _ﻫ＆ ＤBLＳPAＣE ＆ "注意：不要用在不当地方,要尊重他人的劳动成果！”Ｃonｓt MSGＮOＰＷORDＳ１ Aｓ Ｓtrinｇ = "该文件工作表中没有加密＂Consｔ MＳGNOPＷＯRDS２ Aｓ Ｓtring = ＂该文件工作表中没有加密2＂Cｏnｓt MＳGTＡKETIMＥ Ａｓ String = "解密需花费一定时间,请耐心等候！＂ & DＢLSＰACE & ”按确定开始破解!”Coｎsｔ ＭSＧPWORDＦOUNＤ1 As Stｒing = "密码重新组合为：" & DＢＬSPACE ＆ "$$＂ & DBLSPＡＣE ＆ _”如果该文件工作表有不同密码，将搜索下一组密码并修改清除"Cｏnst ＭＳGPWORDFＯＵND2 Ａs Ｓｔrｉng = ”密码重新组合为：” ＆ DBＬＳPACE & ＂$$” ＆ DBLSPACE ＆ _ﻫ"如果该文件工作表有不同密码,将搜索下一组密码并解除"Const MＳGONLYONE Ａs Strｉng = ”确保为唯一的?＂ﻫDim w1 Ａs Worksｈeｅt， w2 As WorkshｅetﻫDim i As Iｎtegeｒ, j Aｓ Iｎｔｅgｅｒ， k As Inｔeｇer， l As InteｇerＤim ｍ Ａs Inｔｅｇeｒ, n Ａs Integer， i1 Aｓ Integer， ｉ2 As InteｇeｒDiｍ i3 As Iｎtegeｒ， i４ Ａｓ Ｉntｅgeｒ, ｉ5 Ａs Integer， ｉ6 As InｔｅgerﻫDim ＰWoｒd1 Ａs SｔrｉngﻫDim SｈＴａｇ Ａs Ｂoolean， WinTａg As BｏoleanＡpplicatioｎ．SｃｒeｅnUｐdatinｇ ＝ ＦalseﻫＷiｔh AcｔiveWorkbookWｉnTａg = ．ＰrotectＳtructｕｒe Or 。
ProtectWindowｓﻫEnｄ ＷitｈShＴaｇ = FaｌｓeﻫFor Eａch w1 Iｎ WｏrkshｅeｔｓSｈＴag = ShTａg Or w１ProtectContentsNeｘt w1ﻫIf Ｎoｔ ShTａg And Not WiｎTａg ThenＭsgBｏｘ MSGNOPＷOＲDS１, vbInｆｏrmａｔion， HＥＡDERＥxit SubEｎd IｆMsgBox ＭSGTＡKETIMＥ, vbＩnformａtion, ＨＥADＥＲﻫＩf Ｎot WinTａg ＴhｅｎﻫElseOn Erroｒ Ｒesume NextＤo ’dｕmｍy do lｏoｐFｏｒ ｉ = 65 To 6６： For j = 65 Ｔo ６６： Ｆｏｒ ｋ = ６5 Ｔo 66ﻫFｏr ｌ ＝ 65 To ６6: For m ＝ 65 To 66: For ｉ１ = 6５ Ｔo ６6Ｆoｒ i2 ＝ 65 To 6６: For i3 ＝ 65 Ｔo 66： Ｆor ｉ4 = 65 Ｔo ６６For i5 = 65 To 66: For i6 = 65 To 6６： Ｆor n = 32 To １２６ﻫWiｔｈ ＡctｉveWorkbookﻫ。
Uｎprｏtｅct Chr(i) ＆ Chr（j） ＆ Cｈｒ（k） ＆ _Chｒ（l) ＆ Chr(m） & Cｈr(i1） ＆ Chr（i２) ＆ _Ｃhr（ｉ3） ＆ Chr(ｉ４） ＆ Chｒ(i5) & Chr（i６） & Chr（n）ﻫＩｆ ．PｒoｔectＳtｒucture = Ｆalse And _．ＰｒotｅctWindｏws ＝ False TｈenﻫＰWｏｒd1 = Chr(i) ＆ Chr（j） ＆ Chｒ（k） ＆ Chr（l） & _ﻫChｒ(ｍ） ＆ Chr（ｉ1) & Chr（i2) & Cｈr（i3） & _Ｃhr（i4) ＆ Ｃhr（ｉ5) ＆ Cｈr（i6) & Chr（n）ﻫMsgBｏｘ ApplicationSｕｂstiｔｕｔe(MＳGPWOＲDＦOUNＤ１， ＿＂＄＄＂, ＰWorｄ１)， ｖbInｆｏrmatiｏn， HEADEＲＥxiｔ Dｏ ’Bｙpasｓ ａlｌ foｒ...ｎexｔｓﻫEnｄ IfEｎｄ WithNeｘt: Next： Next: Next： Next: NextNext： Nｅxｔ： Next： Nｅｘt: Next: NeｘtﻫLooｐ Until TrueﻫOｎ Error ＧoＴo 0ﻫEｎd ＩfIf WinTag Ａnｄ Ｎot ShTag TｈｅnﻫＭsgＢox MＳGONLYOＮＥ, ｖbInformaｔioｎ， HEADEＲExit SubﻫEnd IfOｎ Eｒroｒ Rｅsume NextFor Ｅach w1 In Ｗｏrｋｓｈeetsﻫ’Atｔｅmpt cleａrａｎce wiｔh PWord１w１.Uｎｐroｔecｔ PWoｒd1ﻫNext w1On Eｒrｏr GoＴｏ ０ﻫSｈTaｇ ＝ FａlｓeﻫＦor Eacｈ w1 Iｎ Worksheｅｔs’Cｈecks for all ｃlｅaｒ ＳhTag ｔriｇgeｒed to １ if not.SｈTag = ShTaｇ Oｒ w1。
PｒｏtectContentｓﻫＮext w1ﻫIf ＳhTａg ThenFor Each w1 Iｎ WoｒkshｅetsﻫＷｉth w1ﻫIf .ProｔecｔCｏntents TｈenﻫOｎ Errｏr Reｓume ＮｅxtﻫDo ’Dｕmｍy dｏ looｐﻫFor ｉ ＝ ６５ To 6６: Fｏr ｊ = 6５ To 6６: For ｋ = ６5 To 6６Foｒ l = 65 Tｏ 66： For m = ６5 Tｏ 66： Ｆor i1 = ６5 To 66For i2 = 6５ Tｏ ６６： For i3 = 65 To 66: Foｒ i４ = 65 Tｏ 66Ｆｏr ｉ5 ＝ 65 To 66： Ｆoｒ i6 = ６5 Ｔｏ 6６: Ｆor n = 32 To １26．Uｎpｒotect Chｒ（ｉ) ＆ Chr（j) & Ｃhr(k） ＆ _Ｃhｒ（ｌ) & Chr(m) & Chr（i1) & Chr(i2) & Chr(ｉ３) & _ﻫChr(i4) ＆ Chr(i5) ＆ Cｈr（i6) ＆ Chr（n）ﻫＩf Ｎot ．ProtｅｃtCｏnｔｅntｓ ThenＰＷorｄ1 = Chr(i) ＆ Ｃhr(j） & Chr（k） ＆ Ｃhr(l） ＆ _Ｃｈr（m) & Ｃhr（ｉ１) & Chr（ｉ2) ＆ Chr（i3） & ＿Cｈr(i4） & Ｃhｒ（i5） ＆ Chr(i6) & Chr(ｎ)ＭｓｇBox Applicａtｉon。
Sｕbstitute(MSGPWＯRＤFOＵND２， _ﻫ"＄＄＂， ＰWord１)， vbInfｏrmaｔion, HＥADER’ｌeverage findｉng Pword ｂy ｔryｉｎg ｏn othｅr sheetsﻫFｏr Ｅach w2 Iｎ Worksheetｓﻫｗ2.Uｎｐroｔecｔ PWorｄ1ﻫNeｘt w2ﻫExｉt Do 'Bｙpaｓｓ aｌｌ for．．.ｎｅｘtｓEnｄ ＩfNext： Next: Next： Ｎext： Neｘｔ： ＮeｘtNext： Nｅｘt： Nexｔ： Nｅxt： Next： NexｔＬｏop Ｕntil TrｕeﻫOｎ Error GoTo ０ﻫＥnd IfﻫＥnd ＷithNｅｘt w１ﻫEnｄ IfMｓgBox ALLＣＬEＡR & AUTHORS & VＥＲＳIＯN ＆ REPBAＣK ＆ ZHENＧLI， vbInforｍatiｏn， HEADEＲEnｄ Subﻫ6最后就来执行刚才所建的宏 工具-宏－宏点击执行等带小段时间之后就可以看到效果了文中如有不足，请您指教！8 / 8。