Excel880–VBA批量保护多个工作表(解保护多个工作表)

2015年10月28日10:44:45Excel880–VBA批量保护多个工作表(解保护多个工作表)已关闭评论 8,471 views
微信公众号 【EXCEL880】 QQ群【341401932】
课程咨询 加我微信EXCEL880B 试学网址http://v.excel880.com

用excel简单的权限设置,或者不希望用户破坏界面结构及格式的时候 会对表加密码保护,但是在设计阶段,或者在运行阶段需要对一些数据写入的时候需要临时解开保护再重新加保护,这种情况下如果工作表比较多,手工操作会比较繁琐,还有有VBA利器,本代码就是专门解决批量设置sheet表保护状态 主要代码如下 需要对保护条件做设置 则在批量代码中添加

Option Explicit

'------------Protect Start---Excel880.com---QQ80871835-------
Public Sub E8_ProtectSheet(sht As Worksheet, ByVal flag As Boolean, Optional ByVal password = "")
'**根据工作表名保护或者解保护
'flag=true加保护 false解保护
    'On Error Resume Next
    If flag Then
        sht.Protect password
    Else
        sht.Unprotect password
    End If
End Sub
Public Sub E8_ProtectSheets(shtlist, Optional flag As Boolean = True, Optional password = "")
'**批量工作表保护或者解保护
'shtslist待操作工作表名列表 以逗号分隔 例如
    Dim shts As Sheets, sht As Worksheet, wbk
    Set wbk = ThisWorkbook
    Set shts = wbk.Sheets(Split(shtlist, ","))
    For Each sht In shts
        Call E8_ProtectSheet(sht, flag)
    Next
End Sub
Public Sub E8_ProtectAllSheets(Optional flag As Boolean = True, Optional password = "")
'**批量工作表保护或者解保护
'shtslist待操作工作表名列表 以逗号分隔 例如
    Dim shts As Sheets, sht As Worksheet, wbk
    Set wbk = ThisWorkbook
    Set shts = wbk.Sheets
    For Each sht In shts
        Call E8_ProtectSheet(sht, flag, password)
    Next
End Sub
'------------Protect End---------------

Private Sub Test()
    Dim i&, j&, k&, arr, brr
    '按列表保护
    E8_ProtectSheets "sheet1,sheet2,sheet3,x", True, 123 '加保护
    'E8_ProtectSheets "sheet1,sheet2,sheet3,x", False, 123'解保护
    'E8_ProtectAllSheets True, 123 '保护所有工作表
    'E8_ProtectAllSheets False, 123 '解保护所有工作表
End Sub
Public Sub 批量设置() '本示例 根据参数表对多个工作表设置不同的保护状态和不同的保护密码
    Dim p, i
    For i = 2 To 5
        E8_ProtectSheet ThisWorkbook.Sheets(Cells(i, 1).Value), Cells(i, 2), Cells(i, 3)
    Next
End Sub

案例文件请加公众号Excel880回复60670

表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页