[已解决]怎么能批量保护工作表

ccentaurc2005

哪位知道怎么批量保护工作表,谢谢啦!!
工作表的部分单元格设置了锁定,需要批量保护一个工作薄中的1-40个工作表
要求能选定锁定单元格,选定未锁定单元格和插入行

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-12-3 21:06

1. Sub 批量保护()
   
2.     Dim i&, j&
   
3.     'If Worksheets.Count < 40 Then Exit Sub
   
4.     Do
   
5.         j = Application.InputBox("请输入要锁定的工作表数量" & "[<=" & Worksheets.Count & "]" & vbCr & vbCr & "输入0则退出程序", , , , , , , 1)
   
6.     Loop Until (j > 0 And j <= Worksheets.Count) Or j = 0
   
7.     If j = 0 Then Exit Sub
   
8.     For i = 1 To j
   
9.         Worksheets(i).Protect Password:="6666", DrawingObjects:=True, Contents:=True, Scenarios:=True _
   
10.         , AllowInsertingRows:=True
    
11.     Next
    
12. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

这个好像得用V才行。

hwc2ycy

1. Sub 批量保护()
   
2.     Dim i&
   
3.     If Worksheets.Count < 40 Then Exit Sub
   
4.     For i = 1 To 40
   
5.         Worksheets(i).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
   
6.         , AllowInsertingRows:=True
   
7.     Next
   
8. End Sub

复制代码

hwc2ycy

1. Sub 批量去保护()
   
2.     Dim i&
   
3.     If Worksheets.Count < 40 Then Exit Sub
   
4.     For i = 1 To 40
   
5.         Worksheets(i).Unprotect
   
6.     Next
   
7. End Sub

复制代码

hwc2ycy

1. Sub 批量保护2()
   
2.     Dim i&, j&
   
3.     'If Worksheets.Count < 40 Then Exit Sub
   
4.     Do
   
5.         j = Application.InputBox("请输入要锁定的工作表数量" & "[<=" & Worksheets.Count & "]" & vbCr & vbCr & "输入0则退出程序", , , , , , , 1)
   
6.     Loop Until (j > 0 And j < Worksheets.Count) Or j = 0
   
7.     If j = 0 Then Exit Sub
   
8.     For i = 1 To j
   
9.         Worksheets(i).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
   
10.         , AllowInsertingRows:=True
    
11.     Next
    
12. End Sub

复制代码

ccentaurc2005

hwc2ycy 发表于 2012-12-3 20:38

太谢谢班主任啦!!!能不能再提个小要求啊!!密码还没设置,密码全是"6666"
还是说这个不用设置密码就能保护工作表啊

hwc2ycy

密码只是一个可选项。

hwc2ycy

1. Sub 批量保护()
   
2.     Dim i&, j&
   
3.     'If Worksheets.Count < 40 Then Exit Sub
   
4.     Do
   
5.         j = Application.InputBox("请输入要锁定的工作表数量" & "[<=" & Worksheets.Count & "]" & vbCr & vbCr & "输入0则退出程序", , , , , , , 1)
   
6.     Loop Until (j > 0 And j <= Worksheets.Count) Or j = 0
   
7.     If j = 0 Then Exit Sub
   
8.     For i = 1 To j
   
9.         Worksheets(i).Protect Password:="6666", DrawingObjects:=True, Contents:=True, Scenarios:=True _
   
10.         , AllowInsertingRows:=True
    
11.     Next
    
12. End Sub

复制代码

hwc2ycy

1. Sub 批量密码保护3()
   
2.     Dim i&, j&, pswd$
   
3.     Do
   
4.         j = Application.InputBox("请输入要锁定的工作表数量" & "[<=" & Worksheets.Count & "]" & vbCr & vbCr & "输入0则退出程序", , , , , , , 1)
   
5.     Loop Until (j > 0 And j <= Worksheets.Count) Or j = 0
   
6.     pswd = Application.InputBox("请输入要设置的密码", , , , , , , 2)
   
7. 
   
8.     If j = 0 Then Exit Sub
   
9.     For i = 1 To j
   
10.         Worksheets(i).Protect Password:=pswd, DrawingObjects:=True, Contents:=True, Scenarios:=True _
    
11.         , AllowInsertingRows:=True
    
12.     Next
    
13. End Sub
    

复制代码

hwc2ycy

1. Sub 批量密码保护()
   
2.     Dim i&, j&, pswd$
   
3.     Do
   
4.         j = Application.InputBox("请输入要锁定的工作表数量" & "[<=" & Worksheets.Count & "]" & vbCr & vbCr & "输入0则退出程序", , , , , , , 1)
   
5.     Loop Until (j > 0 And j <= Worksheets.Count) Or j = 0
   
6.     pswd = Application.InputBox("请输入要设置的密码", , , , , , , 2)
   
7. 
   
8.     If j = 0 Then Exit Sub
   
9.     For i = 1 To j
   
10.         If Not Worksheets(i).ProtectContents Then
    
11.         
    
12.             Worksheets(i).Protect Password:=pswd, DrawingObjects:=True, Contents:=True, Scenarios:=True _
    
13.             , AllowInsertingRows:=True
    
14.         Else
    
15.             MsgBox Worksheets(i).Name & "已打开了工作表保护，请先解决保护"
    
16.         End If
    
17.     Next
    
18. End Sub
    
19. 
    
20. Sub 批量去密码保护2()
    
21.     Dim i&, j&, pswd$
    
22.     Do
    
23.         j = Application.InputBox("请输入要去除保护的工作表数量" & "[<=" & Worksheets.Count & "]" & vbCr & vbCr & "输入0则退出程序", , , , , , , 1)
    
24.     Loop Until (j > 0 And j <= Worksheets.Count) Or j = 0
    
25.     On Error Resume Next
    
26.     If j = 0 Then Exit Sub
    
27.     For i = 1 To j
    
28.         If Worksheets(i).ProtectContents Then
    
29.             MsgBox "准备去除 " & Worksheets(i).Name & "的保护，确定后，如有密码提示，请输入正确的密码"
    
30. 1:
    
31.             Worksheets(i).Unprotect
    
32.             If Err.Number <> 0 Then
    
33.                 MsgBox "密码不对，请重新输入"
    
34.                 Err.Clear
    
35.                 GoTo 1
    
36.             End If
    
37.         End If
    
38. 
    
39.     Next
    
40. End Sub
    

复制代码

再改了下，能检测工作表是否有保护。