[已解决]关于表中的权限的问题【追加问题在5楼】

xwp2010

各位老师好，现在我遇到了个问题，需要帮助，附件已经上传了
需求呢就是用不同的用户名打开，看到的内容是不一样的
感谢各位老师。。。

【求助】关于权限的一个问题.rar (28.78 KB, 下载次数: 17)

2016-5-26 23:10 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-5-27 11:07

ThisWorkbook中代码

1. Private Sub Workbook_Open()
   
2.     Application.ScreenUpdating = False
   
3.     ActiveWorkbook.Unprotect Password:="123456"
   
4.     Dim sh As Worksheet
   
5.     For Each sh In Worksheets
   
6.         If sh.Name <> "登录" Then
   
7.             sh.Visible = xlSheetHidden
   
8.         Else
   
9.             sh.Visible = xlSheetVisible
   
10.         End If
    
11.     Next
    
12.     ActiveWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
    
13.     Application.ScreenUpdating = True
    
14. End Sub
    

复制代码

模块代码：

1. Sub 返回()
   
2.     Application.ScreenUpdating = False
   
3.     ActiveWorkbook.Unprotect Password:="123456"
   
4.     With Sheets("登录")
   
5.         .Visible = True
   
6.         ActiveSheet.Visible = False
   
7.         .Select
   
8.     End With
   
9.     Application.ScreenUpdating = True
   
10.     ActiveWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
    
11. End Sub
    
12. Sub 登录()
    
13.     Dim arr, i%, n&, YH$
    
14.     arr = Sheet2.Range("a4:b12") '用户及密码
    
15.     With Sheet1
    
16.         If .[c5] = "" Then
    
17.             MsgBox "用户名不能为空！"
    
18.             Exit Sub
    
19.         End If
    
20.         For i = 1 To 9
    
21.             If .[c5] = arr(i, 1) Then Exit For
    
22.         Next
    
23.         If arr(i, 2) = .[C7] Then
    
24.             YH = Sheet1.[c5]
    
25.             Call SheetQH(Sheets("内容"))
    
26.             With Sheet3
    
27.                 n = .Cells(Rows.Count, 1).End(xlUp).Row
    
28.                 .Unprotect Password:="123456"
    
29.                 .Range("A3:AE" & n).AutoFilter
    
30.                 Select Case YH
    
31.                     Case "华北"
    
32.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFiltering:=True, Password:="123456"
    
33.                     Case "北京"
    
34.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:=YH
    
35.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
36.                     Case "北京战略"
    
37.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:=YH
    
38.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
39.                     Case "天津"
    
40.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:=YH
    
41.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
42.                     Case "青岛、济南"
    
43.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:="=青岛", Operator:=xlOr, Criteria2:="=济南"
    
44.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
45.                     Case "华北IT招聘"
    
46.                         .Range("A3:AE" & n).AutoFilter Field:=6, Criteria1:="=IT招聘", Operator:=xlOr, Criteria2:="=IT外包"
    
47.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
48.                     Case "华北培训"
    
49.                         .Range("A3:AE" & n).AutoFilter Field:=6, Criteria1:="=培训"
    
50.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
51.                     Case "华北外包"
    
52.                         .Range("A3:AE" & n).AutoFilter Field:=6, Criteria1:="<>培训", Operator:=xlAnd, Criteria2:="<>*招聘"
    
53.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
54.                 End Select
    
55.             End With
    
56.         Else
    
57.             MsgBox "密码有误！"
    
58.         End If
    
59.     End With
    
60. End Sub
    
61. Sub SheetQH(sht)
    
62.     Dim sh As Worksheet
    
63.     Application.ScreenUpdating = False
    
64.     ActiveWorkbook.Unprotect Password:="123456"
    
65.     If sht.Name <> ActiveSheet.Name Then
    
66.         With sht
    
67.             .Visible = True
    
68.             ActiveSheet.Visible = False
    
69.             .Select
    
70.         End With
    
71.         For Each sh In Worksheets
    
72.             If sh.Name <> sht.Name Then
    
73.                 sh.Visible = xlSheetHidden
    
74.             End If
    
75.         Next
    
76.     End If
    
77.     Application.ScreenUpdating = True
    
78.     ActiveWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
    
79. End Sub
    

复制代码

自己在加工下！

跳转到最佳答案楼层

老司机带带我

ThisWorkbook中代码

1. Private Sub Workbook_Open()
   
2.     Application.ScreenUpdating = False
   
3.     ActiveWorkbook.Unprotect Password:="123456"
   
4.     Dim sh As Worksheet
   
5.     For Each sh In Worksheets
   
6.         If sh.Name <> "登录" Then
   
7.             sh.Visible = xlSheetHidden
   
8.         Else
   
9.             sh.Visible = xlSheetVisible
   
10.         End If
    
11.     Next
    
12.     ActiveWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
    
13.     Application.ScreenUpdating = True
    
14. End Sub
    

复制代码

模块代码：

1. Sub 返回()
   
2.     Application.ScreenUpdating = False
   
3.     ActiveWorkbook.Unprotect Password:="123456"
   
4.     With Sheets("登录")
   
5.         .Visible = True
   
6.         ActiveSheet.Visible = False
   
7.         .Select
   
8.     End With
   
9.     Application.ScreenUpdating = True
   
10.     ActiveWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
    
11. End Sub
    
12. Sub 登录()
    
13.     Dim arr, i%, n&, YH$
    
14.     arr = Sheet2.Range("a4:b12") '用户及密码
    
15.     With Sheet1
    
16.         If .[c5] = "" Then
    
17.             MsgBox "用户名不能为空！"
    
18.             Exit Sub
    
19.         End If
    
20.         For i = 1 To 9
    
21.             If .[c5] = arr(i, 1) Then Exit For
    
22.         Next
    
23.         If arr(i, 2) = .[C7] Then
    
24.             YH = Sheet1.[c5]
    
25.             Call SheetQH(Sheets("内容"))
    
26.             With Sheet3
    
27.                 n = .Cells(Rows.Count, 1).End(xlUp).Row
    
28.                 .Unprotect Password:="123456"
    
29.                 .Range("A3:AE" & n).AutoFilter
    
30.                 Select Case YH
    
31.                     Case "华北"
    
32.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFiltering:=True, Password:="123456"
    
33.                     Case "北京"
    
34.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:=YH
    
35.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
36.                     Case "北京战略"
    
37.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:=YH
    
38.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
39.                     Case "天津"
    
40.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:=YH
    
41.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
42.                     Case "青岛、济南"
    
43.                         .Range("A3:AE" & n).AutoFilter Field:=4, Criteria1:="=青岛", Operator:=xlOr, Criteria2:="=济南"
    
44.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
45.                     Case "华北IT招聘"
    
46.                         .Range("A3:AE" & n).AutoFilter Field:=6, Criteria1:="=IT招聘", Operator:=xlOr, Criteria2:="=IT外包"
    
47.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
48.                     Case "华北培训"
    
49.                         .Range("A3:AE" & n).AutoFilter Field:=6, Criteria1:="=培训"
    
50.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
51.                     Case "华北外包"
    
52.                         .Range("A3:AE" & n).AutoFilter Field:=6, Criteria1:="<>培训", Operator:=xlAnd, Criteria2:="<>*招聘"
    
53.                         .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, Password:="123456"
    
54.                 End Select
    
55.             End With
    
56.         Else
    
57.             MsgBox "密码有误！"
    
58.         End If
    
59.     End With
    
60. End Sub
    
61. Sub SheetQH(sht)
    
62.     Dim sh As Worksheet
    
63.     Application.ScreenUpdating = False
    
64.     ActiveWorkbook.Unprotect Password:="123456"
    
65.     If sht.Name <> ActiveSheet.Name Then
    
66.         With sht
    
67.             .Visible = True
    
68.             ActiveSheet.Visible = False
    
69.             .Select
    
70.         End With
    
71.         For Each sh In Worksheets
    
72.             If sh.Name <> sht.Name Then
    
73.                 sh.Visible = xlSheetHidden
    
74.             End If
    
75.         Next
    
76.     End If
    
77.     Application.ScreenUpdating = True
    
78.     ActiveWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
    
79. End Sub
    

复制代码

自己在加工下！

安全网

老司机带带我 发表于 2016-5-27 11:07
ThisWorkbook中代码模块代码：自己在加工下！

怎么用好像密码不对

xwp2010

安全网 发表于 2016-5-27 13:03
怎么用好像密码不对

密码在另一个sheet中

用户名	密码	sheet（内容）权限
运营	data1	编辑全部内容
华北	hbka	只能看到全部内容，只读权限
北京	bjka	只能看到D列="北京"的所有内容，其他行隐藏，只读权限
北京战略	bjska	只能看到D列="北京战略"的所有内容，其他行隐藏，只读权限
天津	tjka	只能看到D列="天津"的所有内容，其他行隐藏，只读权限
青岛、济南	qdka	只能看到D列="青岛"&"济南"的所有内容，其他行隐藏，只读权限
华北IT招聘	hbitka	只能看到F列="IT招聘"&"IT外包"的所有内容，其他行隐藏，只读权限
华北培训	hbpx	只能看到F列="培训"的所有内容，其他行隐藏，只读权限
华北外包	hbhro	只能看到F列≠"*招聘"&"培训"的所有内容，其他行隐藏，只读权限

xwp2010

老司机带带我 发表于 2016-5-27 11:07
ThisWorkbook中代码模块代码：自己在加工下！

老师又有一个需求，，请解决。。
关于表中的权限的问题【追加问题】
http://www.excelpx.com/thread-418304-1-1.html

安全网

xwp2010 发表于 2016-5-28 16:38
密码在另一个sheet中

怎么样进入密码表

xwp2010

安全网 发表于 2016-5-30 13:39
怎么样进入密码表

撤销工作薄保护