📄 frm_systemset.frm
字号:
Width = 1695
End
Begin VB.CheckBox Check1
Caption = "基础资料设置"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Index = 0
Left = 360
TabIndex = 4
Top = 0
Width = 1815
End
End
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 5520
Style = 2 'Dropdown List
TabIndex = 0
Top = -45
Width = 1620
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "操作员类型:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 4290
TabIndex = 1
Top = 30
Width = 1155
End
End
Attribute VB_Name = "frm_systemset"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As New ADODB.Recordset
Private Sub Check1_Click(Index As Integer)
If Index = 0 Then
If Check1(0).Value = 0 Then
Check1(1).Value = 0
Check1(2).Value = 0
Check1(3).Value = 0
Check1(4).Value = 0
ElseIf Check1(0).Value = 1 Then
Check1(3).Value = 1
End If
Else
If Check1(Index).Value = 0 Then
If Check1(1).Value = 0 And Check1(2).Value = 0 And Check1(3).Value = 0 And Check1(4).Value = 0 Then
Check1(0).Value = 0
End If
ElseIf Check1(Index).Value = 1 Then
If Check1(1).Value = 1 Or Check1(2).Value = 1 Or Check1(3).Value = 1 Or Check1(4).Value = 1 Then
Check1(0).Value = 1
End If
End If
End If
End Sub
Private Sub Check2_Click(Index As Integer)
If Index = 0 Then
If Check2(0).Value = 0 Then
Check2(1).Value = 0
Check2(2).Value = 0
Check2(3).Value = 0
Check2(4).Value = 0
Check2(5).Value = 0
ElseIf Check2(0).Value = 1 Then
Check2(1).Value = 1
End If
Else
If Check2(Index).Value = 0 Then
If Check2(1).Value = 0 And Check2(2).Value = 0 And Check2(3).Value = 0 And Check2(4).Value = 0 And Check2(5).Value = 0 Then
Check2(0).Value = 0
End If
ElseIf Check2(Index).Value = 1 Then
If Check2(1).Value = 1 Or Check2(2).Value = 1 Or Check2(3).Value = 1 Or Check2(4).Value = 1 Or Check2(5).Value = 1 Then
Check2(0).Value = 1
End If
End If
End If
End Sub
Private Sub Check3_Click(Index As Integer)
If Index = 0 Then
If Check3(0).Value = 0 Then
Check3(1).Value = 0
Check3(2).Value = 0
Check3(3).Value = 0
Check3(4).Value = 0
ElseIf Check3(0).Value = 1 Then
Check3(3).Value = 1
End If
Else
If Check3(Index).Value = 0 Then
If Check3(1).Value = 0 And Check3(2).Value = 0 And Check3(3).Value = 0 And Check3(4).Value = 0 Then
Check3(0).Value = 0
End If
ElseIf Check3(Index).Value = 1 Then
If Check3(1).Value = 1 Or Check3(2).Value = 1 Or Check3(3).Value = 1 Or Check3(4).Value = 1 Then
Check3(0).Value = 1
End If
End If
End If
End Sub
Private Sub Check4_Click(Index As Integer)
If Index = 0 Then
If Check4(0).Value = 0 Then
Check4(1).Value = 0
Check4(2).Value = 0
Check4(3).Value = 0
Check4(4).Value = 0
Check4(5).Value = 0
Check4(6).Value = 0
Check4(7).Value = 0
Check4(8).Value = 0
Check4(9).Value = 0
Check4(10).Value = 0
ElseIf Check4(0).Value = 1 Then
Check4(1).Value = 1
End If
Else
If Check4(Index).Value = 0 Then
If Check4(1).Value = 0 And Check4(2).Value = 0 And Check4(3).Value = 0 And Check4(4).Value = 0 _
And Check4(5).Value = 0 And Check4(6).Value = 0 And Check4(7).Value = 0 _
And Check4(8).Value = 0 And Check4(9).Value = 0 And Check4(10).Value = 0 Then
Check4(0).Value = 0
End If
ElseIf Check4(Index).Value = 1 Then
If Check4(1).Value = 1 Or Check4(2).Value = 1 Or Check4(3).Value = 1 Or Check4(4).Value = 1 _
Or Check4(5).Value = 1 Or Check4(6).Value = 1 Or Check4(7).Value = 1 _
Or Check4(8).Value = 1 Or Check4(9).Value = 1 Or Check4(10).Value = 1 Then
Check4(0).Value = 1
End If
End If
End If
End Sub
Private Sub Combo1_Click()
LoadProperty Combo1.text
End Sub
Private Sub Command1_Click()
Dim i As Long
For i = 0 To 4
Check1(i).Value = 1
Next
For i = 0 To 5
Check2(i).Value = 1
Next
For i = 0 To 4
Check3(i).Value = 1
Next
For i = 0 To 10
Check4(i).Value = 1
Next
End Sub
Private Sub Command2_Click()
Dim i As Long
For i = 0 To 4
Check1(i).Value = 0
Next
For i = 0 To 5
Check2(i).Value = 0
Next
For i = 0 To 4
Check3(i).Value = 0
Next
For i = 0 To 10
Check4(i).Value = 0
Next
End Sub
Private Sub Command3_Click()
Dim i As Long
For i = 0 To 4
cnn.Execute "update usersystem set useflag=" & CBool(Check1(i).Value) & " where pronote='" & Check1(i).Caption & "' and usertype='" & Combo1.text & "'"
Next
For i = 0 To 5
cnn.Execute "update usersystem set useflag=" & CBool(Check2(i).Value) & " where pronote='" & Check2(i).Caption & "' and usertype='" & Combo1.text & "'"
Next
For i = 0 To 4
cnn.Execute "update usersystem set useflag=" & CBool(Check3(i).Value) & " where pronote='" & Check3(i).Caption & "' and usertype='" & Combo1.text & "'"
Next
For i = 0 To 10
cnn.Execute "update usersystem set useflag=" & CBool(Check4(i).Value) & " where pronote='" & Check4(i).Caption & "' and usertype='" & Combo1.text & "'"
Next
cnn.Execute "update usersystem set useflag=" & CBool(Check5.Value) & " where pronote='" & Check5.Caption & "' and usertype='" & Combo1.text & "'"
MsgBox "设置完成。"
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
Combo1.AddItem "仓管员"
Combo1.AddItem "财务"
Combo1.ListIndex = 0
End Sub
Sub LoadProperty(ByVal sName As String)
rs.Open "select * from usersystem where usertype='" & sName & "'", cnn, adOpenDynamic, adLockOptimistic
Do While Not rs.EOF
Select Case rs!proname
Case "mnuSet_jczl"
Check1(0).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuAct_rk"
Check2(0).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_work"
Check3(0).Value = IIf(rs!useflag = True, 1, 0)
Case "mnusql"
Check4(0).Value = IIf(rs!useflag = True, 1, 0)
End Select
rs.MoveNext
Loop
rs.MoveFirst
Do While Not rs.EOF
Select Case rs!proname
Case "mnuSet_protype"
Check1(1).Value = IIf(rs!useflag = True, 1, 0)
Case "mnusetdw"
Check1(2).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuSet_product"
Check1(3).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuSet_sup"
Check1(4).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuEdit_ps"
Check2(1).Value = IIf(rs!useflag = True, 1, 0)
Case "mnutk"
Check2(2).Value = IIf(rs!useflag = True, 1, 0)
Case "mnubs"
Check2(3).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuout"
Check2(4).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuRec_ps"
Check2(5).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_lkzf"
Check3(1).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_ckzf"
Check3(2).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_pdbs"
Check3(3).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_pdby"
Check3(4).Value = IIf(rs!useflag = True, 1, 0)
Case "mnusql_kcmx"
Check4(1).Value = IIf(rs!useflag = True, 1, 0)
Case "mnusql_kcbj"
Check4(2).Value = IIf(rs!useflag = True, 1, 0)
Case "mnuSql_djps"
Check4(3).Value = IIf(rs!useflag = True, 1, 0)
Case "mnu_cgreport"
Check4(4).Value = IIf(rs!useflag = True, 1, 0)
Case "mun_ghcx"
Check4(5).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_outint"
Check4(6).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_obsoleteseek"
Check4(7).Value = IIf(rs!useflag = True, 1, 0)
Case "menu_pdseek"
Check4(8).Value = IIf(rs!useflag = True, 1, 0)
Case "mnusql_out"
Check4(9).Value = IIf(rs!useflag = True, 1, 0)
Case "mnusql_ok"
Check4(10).Value = IIf(rs!useflag = True, 1, 0)
Case "ProSet"
Check5.Value = IIf(rs!useflag = True, 1, 0)
End Select
rs.MoveNext
Loop
If rs.State = adStateOpen Then rs.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -