📄 frm_co.frm
字号:
Top = 2760
Width = 1452
End
Begin VB.Label Label1
Caption = "公司名称："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 360
TabIndex = 18
Top = 3360
Width = 1332
End
Begin VB.Label Label5
Caption = "部门名称："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = -74520
TabIndex = 14
Top = 3480
Width = 1332
End
Begin VB.Label Label4
Caption = "部门编号："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = -74520
TabIndex = 13
Top = 3120
Width = 1212
End
Begin VB.Label Label3
Caption = "分公司名称："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = -74520
TabIndex = 11
Top = 3480
Width = 1452
End
Begin VB.Label Label2
Caption = "分公司编号："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = -74520
TabIndex = 10
Top = 3000
Width = 1452
End
End
End
Attribute VB_Name = "frm_Co"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim active As Integer
Dim str_CoName As String '公司名称
Dim str_F_No, str_F_No1, str_F_Name, str_D_No, str_D_Name As String
Dim rs_Record As String
Dim listview_index As Integer
Dim rs As New ADODB.Recordset
Private Sub cmd_Co_Click(Index As Integer)
Select Case Index
Case 0
active = 0
Cmd_F
Sstab1_Select
txt_D_No.Enabled = True
txt_F_No.Enabled = True
Case 1
active = 1
Cmd_F
Sstab1_Select
txt_D_No.Enabled = False
txt_F_No.Enabled = False
Case 2
active = 1
Sstab1_Select
Record_Delete
Case 3
Record_Add_Edit
Case 4
Cmd_T
Case 5
Unload Me
End Select
End Sub
Private Sub ComboFiliale_Get()
Set rs = GetRecordset(goSys_DB, "select * from pos_Filiale")
If Not rs.EOF Then
ComboFiliale.Clear
rs.MoveFirst
txtF.Text = rs!field_filialeid
Do While Not rs.EOF
ComboFiliale.AddItem rs!field_Filiale
rs.MoveNext
Loop
ComboFiliale.ListIndex = 0
Else
str_Msg = MsgBox("请先增加分公司信息！", vbInformation + vbOKOnly, "<提示信息>")
End If
End Sub
Private Sub ComboFiliale_Click()
If SSTab1.Caption = "部门" And Trim(ComboFiliale.Text) <> "" Then
Set rs = GetRecordset(goSys_DB, "select * from pos_Filiale where field_Filiale='" & Trim(ComboFiliale.Text) & "'")
txtF = rs!field_filialeid
txt_D_No.Enabled = True
txt_D_No.SetFocus
End If
End Sub
Private Sub Form_Load()
List_Get_Record
cmd0_set
End Sub
Private Sub List_Get_Record() '初始化控件
Select Case SSTab1.Caption
Case "公司"
rs_Record = "pos_Co"
listview_index = 0
txt_CoName.Text = ""
listview_Co(listview_index).ColumnHeaders.Clear
listview_Co(listview_index).ListItems.Clear
listview_Co(listview_index).View = lvwReport
listview_Co(listview_index).ColumnHeaders.Add , , "ID", 600
listview_Co(listview_index).ColumnHeaders.Add , , "公司名称", 6000
Rs_Record_Set
Case "分公司"
rs_Record = "pos_Filiale"
listview_index = 1
txt_F_No.Text = ""
txt_F_Name.Text = ""
listview_Co(listview_index).ColumnHeaders.Clear
listview_Co(listview_index).ListItems.Clear
listview_Co(listview_index).View = lvwReport
listview_Co(listview_index).ColumnHeaders.Add , , "ID", 800
listview_Co(listview_index).ColumnHeaders.Add , , "分公司编号", 1500
listview_Co(listview_index).ColumnHeaders.Add , , "分公司名称", 6000
Rs_Record_Set
Case "部门"
ComboFiliale_Get
rs_Record = "pos_Dept"
listview_index = 2
ComboFiliale.Text = ""
txt_D_No.Text = ""
txt_D_Name.Text = ""
listview_Co(listview_index).ColumnHeaders.Clear
listview_Co(listview_index).ListItems.Clear
listview_Co(listview_index).View = lvwReport
listview_Co(listview_index).ColumnHeaders.Add , , "ID", 800
listview_Co(listview_index).ColumnHeaders.Add , , "分公司名称", 2500
listview_Co(listview_index).ColumnHeaders.Add , , "部门编号", 1500
listview_Co(listview_index).ColumnHeaders.Add , , "部门名称", 6000
ComboFiliale_Get
Rs_Record_Set
End Select
End Sub
Private Sub Rs_Record_Set() '显示记录到listview
Dim L As ListItem
Dim i As Integer
Set rs = GetRecordset(goSys_DB, "select * from " & rs_Record)
i = 1
If rs.EOF Then
Exit Sub
Else
rs.MoveFirst
Do While Not rs.EOF
Set L = listview_Co(listview_index).ListItems.Add(, , i)
Select Case rs_Record
Case "pos_Co"
L.SubItems(1) = CStr(rs!field_Co)
Case "pos_Filiale"
L.SubItems(1) = CStr(rs!field_filialeid)
L.SubItems(2) = CStr(rs!field_Filiale)
Case "pos_Dept"
L.SubItems(1) = CStr(rs!field_Filiale)
L.SubItems(2) = CStr(rs!field_Deptid)
L.SubItems(3) = CStr(rs!field_Dept)
End Select
i = i + 1
rs.MoveNext
Loop
End If
End Sub
Private Sub Cmd_T()
cmd_Co(0).Enabled = True
cmd_Co(1).Enabled = True
cmd_Co(2).Enabled = True
cmd_Co(3).Enabled = False
cmd_Co(4).Enabled = False
cmd_Co(5).Enabled = True
End Sub
Private Sub Cmd_F()
cmd_Co(0).Enabled = False
cmd_Co(1).Enabled = False
cmd_Co(2).Enabled = False
cmd_Co(3).Enabled = True
cmd_Co(4).Enabled = True
cmd_Co(5).Enabled = False
End Sub
Private Sub Sstab1_Select()
Dim i As Integer
Select Case SSTab1.Caption
Case "公司"
If active = 0 And listview_Co(listview_index).ListItems.Count = 0 Then
txt_CoName.Text = ""
txt_CoName.SetFocus
Else
If listview_Co(listview_index).ListItems.Count = 0 Then
str_Msg = MsgBox("没有可供修改的记录！", vbInformation + vbOKOnly, "<提示信息>")
Cmd_T
active = 3
Exit Sub
Else
i = listview_Co(listview_index).SelectedItem
txt_CoName.Text = listview_Co(listview_index).ListItems(i).SubItems(1)
str_CoName = txt_CoName.Text '保留修改前的值
End If
End If
Case "分公司"
If active = 0 Then
txt_F_No.Text = ""
txt_F_Name.Text = ""
txt_F_No.Enabled = True
txt_F_No.SetFocus
Else
If listview_Co(listview_index).ListItems.Count = 0 Then
str_Msg = MsgBox("没有可供修改的记录！", vbInformation + vbOKOnly, "<提示信息>")
Cmd_T
active = 3
Exit Sub
Else
i = listview_Co(listview_index).SelectedItem
txt_F_No.Text = listview_Co(listview_index).ListItems(i).SubItems(1)
txt_F_Name.Text = listview_Co(listview_index).ListItems(i).SubItems(2)
str_F_No = txt_F_No.Text
str_F_Name = txt_F_Name.Text
txt_F_No.Enabled = False
End If
End If
Case "部门"
If active = 0 Then
ComboFiliale.SetFocus
txt_D_No.Text = ""
txt_D_Name.Text = ""
Else
If listview_Co(listview_index).ListItems.Count = 0 Then
str_Msg = MsgBox("没有可供修改的记录！", vbInformation + vbOKOnly, "<提示信息>")
active = 3
Cmd_T
Exit Sub
Else
i = listview_Co(listview_index).SelectedItem
ComboFiliale.Text = listview_Co(listview_index).ListItems(i).SubItems(1)
txt_D_No.Text = Right(Trim(listview_Co(listview_index).ListItems(i).SubItems(2)), 2)
txtF.Text = Left(Trim(listview_Co(listview_index).ListItems(i).SubItems(2)), 2)
txt_D_Name.Text = listview_Co(listview_index).ListItems(i).SubItems(3)
str_F_No1 = ComboFiliale.Text
str_D_No = listview_Co(listview_index).ListItems(i).SubItems(2)
str_D_Name = txt_D_Name.Text
End If
End If
End Select
End Sub
Private Sub Record_Add_Edit()
Select Case SSTab1.Caption
Case "公司"
If active = 0 Then '增加记录 '//当字符串中有一个单引号时，对数据库进行插入与修改就会出错
goSys_DB.Execute "insert pos_Co(field_Co) values('" & Trim(txt_CoName) & "')"
List_Get_Record
ElseIf active = 1 And str_CoName <> txt_CoName.Text Then '如果该记录作了修改则保存
goSys_DB.Execute "update pos_Co set field_Co='" & Trim(txt_CoName) & "' where field_Co='" & Trim(str_CoName) & "'"
List_Get_Record
End If
Case "分公司"
If active = 0 Then '增加记录 '//当字符串中有一个单引号时，对数据库进行插入与修改就会出错
Set rs = GetRecordset(goSys_DB, "select * from pos_Filiale where field_FilialeID='" & Trim(txt_F_No.Text) & "'")
If Not rs.EOF Then '该员工编号在数据库中已经存在！
str_Msg = MsgBox("该分公司编号在数据库中已经存在，请核对！", vbInformation + vbOKOnly, "<提示信息>")
Exit Sub
End If
goSys_DB.Execute "insert pos_Filiale(field_FilialeID,field_Filiale) values('" & Trim(txt_F_No.Text) & "','" & Trim(txt_F_Name.Text) & "')"
List_Get_Record
Cmd_T
ElseIf active = 1 And (str_F_Name <> txt_F_Name.Text Or str_F_No <> ComboFiliale.Text) Then '如果该记录作了修改则保存
goSys_DB.Execute "update pos_Filiale set field_Filiale='" & Trim(txt_F_Name) & "' where field_FilialeID='" & Trim(str_F_No) & "'"
List_Get_Record
Cmd_T
End If
Case "部门"
Dim txtDeptId As String
txtDeptId = Trim(txtF.Text) & Trim(txt_D_No.Text)
If active = 0 Then '增加记录 '//当字符串中有一个单引号时，对数据库进行插入与修改就会出错
Set rs = GetRecordset(goSys_DB, "select * from pos_Dept where field_DeptID='" & Trim(txtDeptId) & "'")
If Not rs.EOF Then '该员工编号在数据库中已经存在！
str_Msg = MsgBox("该部门编号在数据库中已经存在，请核对！", vbInformation + vbOKOnly, "<提示信息>")
Exit Sub
End If
goSys_DB.Execute "insert pos_Dept(field_filialeid,field_Filiale,field_DeptID,field_Dept) values('" & Trim(txtF.Text) & "','" & Trim(ComboFiliale.Text) & "','" & Trim(txtDeptId) & "','" & Trim(txt_D_Name.Text) & "')"
List_Get_Record
Cmd_T
ElseIf active = 1 And (str_F_Name <> txt_F_Name.Text Or str_F_No <> ComboFiliale.Text) Then '如果该记录作了修改则保存
goSys_DB.Execute "update pos_Dept set field_Dept='" & Trim(txt_D_Name) & "' where field_DeptID='" & Trim(str_D_No) & "'"
List_Get_Record
Cmd_T
End If
End Select
End Sub
Private Sub Record_Delete()
If active = 3 Then
Exit Sub
Else
If MsgBox("确定要删除该记录吗?", vbCritical + vbOKCancel, "<提示信息>") = vbOK Then
Select Case SSTab1.Caption
Case "公司"
goSys_DB.Execute "delete from pos_Co where field_Co='" & str_CoName & "'"
Cmd_T
Case "分公司"
goSys_DB.Execute "delete from pos_Filiale where field_FilialeID='" & str_F_No & "'"
Case "部门"
goSys_DB.Execute "delete from pos_Dept where field_DeptID='" & str_D_No & "'"
End Select
List_Get_Record
End If
End If
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
List_Get_Record
cmd0_set
End Sub
Private Sub cmd0_set()
Cmd_T
If SSTab1.Caption = "公司" Then
Set rs = GetRecordset(goSys_DB, "select * from pos_co ")
If Not rs.EOF Then
cmd_Co(0).Enabled = False
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -