微信公众号 【EXCEL880】 QQ群【341401932】
课程咨询 加我微信EXCEL880B 试学网址http://v.excel880.com
课程咨询 加我微信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