宏运行工作表保护后允许自动帅选(保护密码是1234)

feiaoli

请各位大佬伸出友爱的援助之手，不胜感激！
1、宏运行工作表保护后允许自动帅选。
2、保护时候去掉   "选定锁定单元格"勾选。
3、保护密码是1234

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. 
   
3. 
   
4. ActiveSheet.Unprotect "1234" '解除工作表保护1234是保护密码
   
5. Dim X As Integer '解除所有工作表保护
   
6.       For X = 1 To Sheets.Count '解除所有工作表保护
   
7.          ' Sheets(X).Unprotect "1234" '解除所有工作表保护
   
8.       Next X '解除所有工作表保护
   
9. Dim sht As Worksheet
   
10. Dim sh As Worksheet
    
11. 
    
12. 
    
13. 'Dim sht As Worksheet
    
14. 'Dim sh As Worksheet
    
15. Set sht = ThisWorkbook.Sheets("数据库")
    
16. Set sh = ThisWorkbook.Sheets("县级预算项目资金支出计划申请书")
    
17. Application.EnableEvents = False
    
18. If Target.Address = "$E$3" And Not IsEmpty(Target) Then
    
19.     With sht
    
20.        r = .Cells(.Rows.Count, "AV").End(3).Row
    
21.        For i = 2 To r
    
22.            If .Cells(i, "AV").Value = Target.Value Then
    
23.                 arr = .Cells(i, 1).Resize(, 64)
    
24.                 MsgBox "找到位置，在数据库的第：" & i & " 行"
    
25.                 Exit For
    
26.            End If
    
27.        Next
    
28.     End With
    
29.    
    
30.     If Not IsEmpty(arr) Then
    
31.         With sh
    
32.             .[b2] = Mid(arr(1, 1), 9, 11)
    
33.             .[e2] = arr(1, 2)
    
34.             .[b3] = arr(1, 50)
    
35.             .[b4] = arr(1, 52)
    
36.             .[b5] = arr(1, 45)
    
37.             .[b6] = arr(1, 4)
    
38.             .[d4] = arr(1, 56)
    
39.             .[d5] = arr(1, 46)
    
40.             .[d6] = arr(1, 12) + arr(1, 13)
    
41.         '    .[f4] = arr(1, 56)
    
42.         '    .[f5] = arr(1, 56)
    
43.         '    .[f6] = arr(1, 56)
    
44.             .[a7] = "预算单位意见（领导签字盖公章）:" + arr(1, 50)
    
45.         End With
    
46.     Else
    
47.         MsgBox "没有找到你输入的指标号，退出！"
    
48.         With sh
    
49.         .[b2:c2] = ""
    
50.         .[e2:f2] = ""
    
51.         .[b3:c3] = ""
    
52.         .[b4] = ""
    
53.         .[b5] = ""
    
54.         .[b6] = ""
    
55.         .[d4] = ""
    
56.         .[d5] = ""
    
57.         .[d6] = ""
    
58.         .[f4] = ""
    
59.         .[f5] = ""
    
60.         .[f6] = ""
    
61.         .[a7:f7] = ""
    
62.         End With
    
63.     End If
    
64. ElseIf Target.Address = "$E$3" And IsEmpty(Target) Then
    
65.     With sh
    
66.         .[b2:c2] = ""
    
67.         .[e2:f2] = ""
    
68.         .[b3:c3] = ""
    
69.         .[b4] = ""
    
70.         .[b5] = ""
    
71.         .[b6] = ""
    
72.         .[d4] = ""
    
73.         .[d5] = ""
    
74.         .[d6] = ""
    
75.         .[f4] = ""
    
76.         .[f5] = ""
    
77.         .[f6] = ""
    
78.         .[a7:f7] = ""
    
79.     End With
    
80. End If
    
81. Application.EnableEvents = True
    
82. 
    
83. 
    
84. ActiveSheet.Protect "1234" '工作表保护1234是保护密码
    
85.      AllowFiltering = True                           '密码保护后允许筛选
    
86. Dim b As Integer '保护所有工作表
    
87.       For b = 1 To Sheets.Count '保护所有工作表
    
88.           Sheets(b).Protect "1234" '保护所有工作表
    
89.       Next b '保护所有工作表
    
90. 
    
91. End Sub
    
92. 
    
93. 
    
94. 
    

复制代码

再次谢谢taller老师无私的帮助。

feiaoli

在线等老师！

feiaoli

等待老师！

taller

feiaoli

taller 发表于 2024-2-25 12:38

老师，选定《单元格勾选去掉了》，但是《没有勾选上 自动筛选》，因为是VBA小白，还请老师多多指教。

1. '-------------  '工作表保护1234是保护密码'密码保护后允许筛选--------------
   
2.      ActiveSheet.EnableSelection = xlUnlockedCells
   
3.      ActiveSheet.Protect "1234", AllowFiltering = True ', EnableAutoFilter = True,ShowAutoFilter = True
   
4. '----------------工作表保护1234是保护密码'密码保护后允许筛选--------------
   
5. Dim b As Integer '保护所有工作表
   
6.       For b = 1 To Sheets.Count '保护所有工作表
   
7.           Sheets(b).Protect "1234" '保护所有工作表
   
8.       Next b '保护所有工作表

复制代码

feiaoli

taller 发表于 2024-2-25 12:38

再次谢谢老师！一下子没有领悟到老师的意思，修改了一下！
（已解决）宏运行工作表保护后允许自动帅选(保护密码是1234)

1. '-------------  '工作表保护1234是保护密码'密码保护后允许筛选--------------
   
2. ActiveSheet.EnableSelection = xlUnlockedCells
   
3. Dim b As Integer '保护所有工作表
   
4.       For b = 1 To Sheets.Count '保护所有工作表
   
5.         Sheets(b).Protect "1234", Contents:=True, AllowFiltering:=True   '保护所有工作表允许保护后自动筛选
   
6.       Next b
   
7. '-------------  '工作表保护1234是保护密码'密码保护后允许筛选--------------

复制代码