VBA解除Excel工作表保护

Excel工作表保护解除

工作表保护后无法编辑内容,可能是密码忘记,不可暴力破解隐私

1 打开需的Excel

2 Alt + F11 打开代码编辑,点击任意代码编辑项,将如下代码复制,并运行。

Public Sub GetWorkbookPassword()

Dim w1 As Worksheet, w2 As Worksheet
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim 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
Application.DisplayAlerts = False


    WinTag = ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows

    ShTag = False
    For Each w1 In Worksheets
        ShTag = ShTag Or w1.ProtectContents
    Next w1

    If Not ShTag And Not WinTag Then
        MsgBox "该工作表没有设置保护密码", , "系统提示"
        Exit Sub
    End If

    If Not WinTag Then
    Else
        On Error Resume Next
        Do
        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
            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 ActiveWorkbook.ProtectStructure = False And ActiveWorkbook.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)
                Exit Do
            End If

        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 "确保密码唯一的?", , "系统提示"
        Exit Sub
    End If

    On Error Resume Next
    For Each w1 In Worksheets
        w1.Unprotect PWord1
    Next w1

    On Error GoTo 0
    ShTag = False

    For Each w1 In Worksheets
        ShTag = ShTag Or w1.ProtectContents
    Next w1

    If ShTag Then
        For Each w1 In Worksheets

            If w1.ProtectContents Then
                On Error Resume Next
                Do
                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
                    w1.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 w1.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)
                        For Each w2 In Worksheets
                            w2.Unprotect PWord1
                        Next w2
                        Exit Do
                    End If
                Next: Next: Next: Next: Next: Next
                Next: Next: Next: Next: Next: Next
                Loop Until True
                On Error GoTo 0
            End If
        Next w1
    End If
    MsgBox "该工作簿中的工作表密码保护已全部解除!请记得另存", , "系统提示"

Application.ScreenUpdating = False
Application.DisplayAlerts = False

End Sub
相关推荐
图片转成excel表格34 分钟前
wps怎么算出一行1和0两种数值中连续数值1的个数,出现0后不再计算?
excel·wps
q2498596931 小时前
前端预览word、excel、ppt
前端·word·excel
丁德双15 小时前
winform 加载 office excel 插入QRCode图片如何设定位置
c#·excel
IT铺子17 小时前
Excel 个人时间管理工具
excel
zxguan1 天前
EasyExcel 学习之 导出 “提示问题”
学习·excel
忘忧记1 天前
Excel批量转换不规范数据的教程
excel
神奇夜光杯1 天前
Python酷库之旅-第三方库Pandas(200)
开发语言·人工智能·python·excel·pandas·标准库及第三方库·学习与成长
火星技术1 天前
Excel快速转换文档word工具
word·excel
 嘘 1 天前
文件操作:Xml转Excel
xml·python·excel
Mr。轩。1 天前
cn.afterturn.easypoi.exception.excel.ExcelExportException: Excel导出错误 -> 修正过程。
java·excel·导出