📄 formyhxx.frm
字号:
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 19
Top = 765
Width = 855
End
Begin VB.Label Label2
Caption = "拼 音 码"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2640
TabIndex = 18
Top = 405
Width = 735
End
Begin VB.Label Label1
Caption = "联 系 人"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 17
Top = 405
Width = 735
End
End
Begin VB.TextBox txtBZ
Height = 315
Left = 1080
TabIndex = 14
Top = 2640
Width = 6345
End
Begin VB.TextBox txtJDR
Enabled = 0 'False
Height = 320
Left = 6000
TabIndex = 2
Top = 600
Width = 1455
End
Begin VB.TextBox txtGJRQ
Height = 320
Left = 3600
TabIndex = 1
Top = 600
Width = 1455
End
Begin VB.TextBox txtYHID
Enabled = 0 'False
Height = 320
Left = 1080
TabIndex = 0
Top = 600
Width = 1575
End
Begin VB.Image Image1
Height = 240
Left = 240
Picture = "FormYHXX.frx":0B65
Top = 600
Width = 240
End
Begin VB.Label Label11
Caption = "建 档 人"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5160
TabIndex = 26
Top = 645
Width = 855
End
Begin VB.Label Label10
Caption = "购买日期"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2760
TabIndex = 25
Top = 645
Width = 735
End
Begin VB.Label Label9
Caption = "编号"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 585
TabIndex = 24
Top = 645
Width = 435
End
Begin VB.Label Label8
Caption = "服务说明"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 23
Top = 2700
Width = 765
End
End
Attribute VB_Name = "FormYHXX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addlist1 As ListItem
Dim addlist2 As ListItem
Private Sub cmdTJHF_Click()
hfidcd = ""
FormHF.Show 1
End Sub
Private Sub cmdTJWX_Click()
wxidcd = ""
FormWXD.Show 1
End Sub
Private Sub Combo1_LostFocus()
If Me.Combo1.Text = "直接客户" Or Me.Combo1.Text = "间接客户" Then
Exit Sub
Else
MsgBox "选择值错误，请从列表中选取！", 48, "错误信息"
Me.Combo1.Text = "直接客户"
End If
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
ListView1.ListItems.Clear
ListView2.ListItems.Clear
Call OpenConn
sql = "select * from wxb where wyhid='" & yhxhcd & "' ORDER BY bxrq"
rs.Open sql, cn, 1, 1
Do While Not rs.EOF
Set addlist1 = ListView1.ListItems.Add(, , rs.Fields("wxid"), , 1) '将各项数据加入list列表
addlist1.SubItems(1) = IIf(IsNull(rs.Fields("bxr")), "", rs.Fields("bxr"))
addlist1.SubItems(2) = IIf(IsNull(rs.Fields("bxdh")), "", rs.Fields("bxdh"))
addlist1.SubItems(3) = IIf(IsNull(rs.Fields("bxrq")), "", rs.Fields("bxrq"))
addlist1.SubItems(4) = IIf(IsNull(rs.Fields("fwlx")), "", rs.Fields("fwlx"))
addlist1.SubItems(5) = IIf(IsNull(rs.Fields("fwfs")), "", rs.Fields("fwfs"))
addlist1.SubItems(6) = IIf(IsNull(rs.Fields("wxry")), "", rs.Fields("wxry"))
addlist1.SubItems(7) = IIf(IsNull(rs.Fields("fwpj")), "", rs.Fields("fwpj"))
addlist1.SubItems(8) = IIf(IsNull(rs.Fields("gzxx")), "", rs.Fields("gzxx"))
rs.MoveNext
Loop
Call CloseConn
Call OpenConn
sql = "select * from hfb where hyhid='" & yhxhcd & "' order by hfrq"
rs.Open sql, cn, 1, 1
Do While Not rs.EOF
Set addlist2 = ListView2.ListItems.Add(, , rs.Fields("hfid"), , 2) '将各项数据加入listview
addlist2.SubItems(1) = IIf(IsNull(rs.Fields("cppj")), "", rs.Fields("cppj"))
addlist2.SubItems(2) = IIf(IsNull(rs.Fields("fwpj")), "", rs.Fields("fwpj"))
addlist2.SubItems(3) = IIf(IsNull(rs.Fields("hfr")), "", rs.Fields("hfr"))
addlist2.SubItems(4) = IIf(IsNull(rs.Fields("hfrq")), "", rs.Fields("hfrq"))
addlist2.SubItems(5) = IIf(IsNull(rs.Fields("syqk")), "", rs.Fields("syqk"))
rs.MoveNext
Loop
Call CloseConn
End Sub
Private Sub ListView1_DblClick()
If ListView1.ListItems.Count <= 0 Then Exit Sub
wxidcd = ListView1.SelectedItem
FormWXD.Show 1
End Sub
Private Sub ListView2_DblClick()
If ListView2.ListItems.Count <= 0 Then Exit Sub
hfidcd = ListView2.SelectedItem
FormHF.Show 1
End Sub
Private Sub txtGJRQ_LostFocus()
'~~~~~~~~~~日期格式~~~~~~~~~~~~~~~~
If IsDate(txtGJRQ.Text) Then
txtGJRQ = Format(txtGJRQ.Text, yyyymmdd)
Else
txtGJRQ = ""
End If
End Sub
Private Sub txtLXR_LostFocus()
'获得用户名拼音码~~~~~~~~~~~~~~~~~~~`
Dim a As Integer
txtPYM.Text = ""
a = Len(txtLXR.Text)
For i = 1 To a
txtPYM.Text = txtPYM.Text & py(Mid(txtLXR.Text, i, 1))
Next i
End Sub
Private Sub txtZJBH_Change()
'~~~~~~~~~~~~~验证文本有效性~~~~~~~~~~~~~~~~~~~~
If Len(txtZJBH.Text) = 16 Or Len(txtZJBH.Text) = 18 Then
txtZJBH.BackColor = &H80000005
Else
txtZJBH.BackColor = &H80C0FF
End If
End Sub
Private Sub txtZJBH_GotFocus()
'~~~~~~~~~~~~~验证文本有效性~~~~~~~~~~~~~~~~~~~~
If Len(txtZJBH.Text) = 16 Or Len(txtZJBH.Text) = 18 Then
txtZJBH.BackColor = &H80000005
Else
txtZJBH.BackColor = &H80C0FF
End If
End Sub
Private Sub cmdXG_Click()
'更新时数据验证~~~~~~~~~~~~~~~~~~~~~~~~~~~
'If czyqx = "业务员" Then
' MsgBox "权限不够，不能进行更新记录操作！", 48, "错误提示"
' Exit Sub
'End If
If txtGJRQ.Text = "" Then
MsgBox "购买日期不能为空！", 48, "错误提示"
txtGJRQ.SetFocus
Exit Sub
End If
If txtLXR.Text = "" Then
MsgBox "联系人不能为空！", 48, "错误提示"
txtLXR.SetFocus
Exit Sub
End If
If txtYHDH.Text = "" And txtYHSJ.Text = "" Then
MsgBox "用户电话或手机必须填写一项！", 48, "错误提示"
txtYHDH.SetFocus
Exit Sub
End If
If txtZJXH.Text = "" Then
MsgBox "软件版本不能为空！", 48, "错误提示"
txtZJXH.SetFocus
Exit Sub
End If
If txtZJBH.Text = "" Then
MsgBox "加密卡号不能为空！", 48, "错误提示"
txtZJBH.SetFocus
Exit Sub
End If
'更新数据~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
sql = "select * from yhda where yhid='" & txtYHID.Text & "'"
rs.Open sql, cn, 3, 3
rs.Fields("lxr") = txtLXR.Text
rs.Fields("pym") = txtPYM.Text
rs.Fields("yhlx") = Me.Combo1.Text
rs.Fields("yhdw") = txtYHDW.Text
rs.Fields("yhdz") = txtYHDZ.Text
rs.Fields("yhdh") = txtYHDH.Text
rs.Fields("yhsj") = txtYHSJ.Text
rs.Fields("zjxh") = txtZJXH.Text
rs.Fields("zjbh") = txtZJBH.Text
rs.Fields("xsqxh") = txtXSQXH.Text
rs.Fields("xsqbh") = txtXSQBH.Text
rs.Fields("gjrq") = txtGJRQ.Text
rs.Fields("jdr") = czy
rs.Fields("bz") = txtBZ.Text
rs.Update
Call CloseConn
'更新结束~~~~~~~~~~~~~~~~~~~~~~~~~~~
'更新formZY listview~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FormZY.cmdCZ = True
MsgBox "记录已更新完毕！", 64, "操作成功"
End Sub
Private Sub Form_Load()
'设置相关信息~~~~~~~~~~~~~~~~~~~~~~~
Me.Caption = xtmc
Me.Icon = FormZY.Icon
Me.Combo1.AddItem "直接客户"
Me.Combo1.AddItem "间接客户"
If czyqx = "业务员" Then
cmdXG.Visible = False
End If
'取出数据到相应位置~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
sql = "select * from yhda where yhid='" & yhxhcd & "'"
rs.Open sql, cn, 1, 1
txtYHID.Text = rs.Fields("yhid")
txtGJRQ.Text = rs.Fields("gjrq")
txtJDR.Text = rs.Fields("jdr")
txtLXR.Text = rs.Fields("lxr")
txtPYM.Text = rs.Fields("pym")
Me.Combo1.Text = rs.Fields("yhlx")
txtYHDW.Text = rs.Fields("yhdw")
txtYHDZ.Text = rs.Fields("yhdz")
txtYHDH.Text = rs.Fields("yhdh")
txtYHSJ.Text = rs.Fields("yhsj")
txtZJXH.Text = rs.Fields("zjxh")
txtZJBH.Text = rs.Fields("zjbh")
txtXSQXH.Text = rs.Fields("xsqxh")
txtXSQBH.Text = rs.Fields("xsqbh")
txtBZ.Text = rs.Fields("bz")
Call CloseConn
'添加listview1标头、宽度~~~~~~~~~~~~~~~~~~~~~`
With ListView1
.View = lvwReport
.ColumnHeaders.Add = "服务单号"
.ColumnHeaders.Add = "客户名称"
.ColumnHeaders.Add = "客户电话"
.ColumnHeaders.Add = "报修日期"
.ColumnHeaders.Add = "服务类型"
.ColumnHeaders.Add = "服务方式"
.ColumnHeaders.Add = "服务人员"
.ColumnHeaders.Add = "服务评价"
.ColumnHeaders.Add = "故障现象"
.ColumnHeaders(5).Width = 1000
.ColumnHeaders(6).Width = 1000
.ColumnHeaders(7).Width = 1000
.ColumnHeaders(8).Width = 1000
.ColumnHeaders(9).Width = 3000
End With
'添加listview1数据~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
sql = "select * from wxb where wyhid='" & yhxhcd & "' ORDER BY bxrq"
rs.Open sql, cn, 1, 1
Do While Not rs.EOF
Set addlist1 = ListView1.ListItems.Add(, , rs.Fields("wxid"), , 1) '将各项数据加入list列表
addlist1.SubItems(1) = IIf(IsNull(rs.Fields("bxr")), "", rs.Fields("bxr"))
addlist1.SubItems(2) = IIf(IsNull(rs.Fields("bxdh")), "", rs.Fields("bxdh"))
addlist1.SubItems(3) = IIf(IsNull(rs.Fields("bxrq")), "", rs.Fields("bxrq"))
addlist1.SubItems(4) = IIf(IsNull(rs.Fields("fwlx")), "", rs.Fields("fwlx"))
addlist1.SubItems(5) = IIf(IsNull(rs.Fields("fwfs")), "", rs.Fields("fwfs"))
addlist1.SubItems(6) = IIf(IsNull(rs.Fields("wxry")), "", rs.Fields("wxry"))
addlist1.SubItems(7) = IIf(IsNull(rs.Fields("fwpj")), "", rs.Fields("fwpj"))
addlist1.SubItems(8) = IIf(IsNull(rs.Fields("gzxx")), "", rs.Fields("gzxx"))
rs.MoveNext
Loop
Call CloseConn
'添加listview2标头~~~~~~~~~~~~~~~~~~~~~~~
With ListView2
.View = lvwReport
.ColumnHeaders.Add = "回访编号"
.ColumnHeaders.Add = "产品评价"
.ColumnHeaders.Add = "服务评价"
.ColumnHeaders.Add = "回访人"
.ColumnHeaders.Add = "回访日期"
.ColumnHeaders.Add = "使用情况"
.ColumnHeaders(6).Width = 3000
End With
'添加listview2标头~~~~~~~~~~~~~~~~~~~~
Call OpenConn
sql = "select * from hfb where hyhid='" & yhxhcd & "' order by hfrq"
rs.Open sql, cn, 1, 1
Do While Not rs.EOF
Set addlist2 = ListView2.ListItems.Add(, , rs.Fields("hfid"), , 2) '将各项数据加入listview
addlist2.SubItems(1) = IIf(IsNull(rs.Fields("cppj")), "", rs.Fields("cppj"))
addlist2.SubItems(2) = IIf(IsNull(rs.Fields("fwpj")), "", rs.Fields("fwpj"))
addlist2.SubItems(3) = IIf(IsNull(rs.Fields("hfr")), "", rs.Fields("hfr"))
addlist2.SubItems(4) = IIf(IsNull(rs.Fields("hfrq")), "", rs.Fields("hfrq"))
addlist2.SubItems(5) = IIf(IsNull(rs.Fields("syqk")), "", rs.Fields("syqk"))
rs.MoveNext
Loop
Call CloseConn
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -