📄 flpnew.frm
字号:
Attribute VB_Name = "FlpNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub addmenu_Click()
Call isButton3_Click
End Sub
Private Sub Cbo_KeyPress(KeyAscii As Integer)
Call Tinsert_KeyPress(13)
End Sub
Private Sub changemenu_Click()
Call MSFzy_DblClick
End Sub
Private Sub delmenu_Click()
Call MSFzyDelMsg(MSFzy.TextMatrix(MSFzy.Row, 0))
Call vsqlshow("")
End Sub
Private Sub Form_Load()
Dim ssql As String
Dim vda As String
Dim c As cTab
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
With vTab
Set c = .Tabs.Add("SOLUTION", , "理赔管理")
c.IconIndex = 0
c.Panel = Pickl
End With
vTab.ShowCloseButton = False
Call Form_Resize
'Call showTital
vda = DateAdd("m", -1, Date)
ssql = "where vdate > #" & vda & "#"
Call vsqlshow(ssql)
End Sub
Private Sub Form_Resize()
Me.Width = Fmain.Width
Me.Height = Fmain.Height
Me.Left = 0
Me.Top = Fmain.Top
vTab.Height = Me.ScaleHeight - Frame1.Height
Pickl.Width = Me.Width
Frame1.Width = Me.ScaleWidth
MSFzy.Width = Pickl.Width
MSFzy.Height = Pickl.Height
End Sub
Private Sub showTital()
'MSFzy.Cols = 11
InitSingleCol FlpNew.MSFzy, "", 0, 0, 0
InitSingleCol FlpNew.MSFzy, "报案日期", 1, 0, 1600
InitSingleCol FlpNew.MSFzy, "保险单编号", 2, 0, 2200
InitSingleCol FlpNew.MSFzy, "被保险人", 3, 0, 1500
InitSingleCol FlpNew.MSFzy, "行驶证车主", 4, 0, 1500
InitSingleCol FlpNew.MSFzy, "被保人手机", 5, 0, 1900
InitSingleCol FlpNew.MSFzy, "推荐人", 6, 0, 1500
InitSingleCol FlpNew.MSFzy, "推荐人电话", 7, 0, 1900
InitSingleCol FlpNew.MSFzy, "厂牌型号", 8, 0, 1500
InitSingleCol FlpNew.MSFzy, "车 牌 号", 9, 0, 1500
InitSingleCol FlpNew.MSFzy, "修理厂家", 10, 0, 1800
InitSingleCol FlpNew.MSFzy, "修理厂电话", 11, 0, 1800
InitSingleCol FlpNew.MSFzy, "损失金额", 12, 0, 1500
InitSingleCol FlpNew.MSFzy, "实际赔付", 13, 0, 2540
InitSingleCol FlpNew.MSFzy, "备 注", 14, 0, 2000
InitSingleCol FlpNew.MSFzy, "结 案", 15, 0, 800
InitSingleCol FlpNew.MSFzy, "满 意 度", 16, 0, 800
InitSingleCol FlpNew.MSFzy, "其 它", 17, 0, 2000
MSFzy.Rows = 1
End Sub
Private Sub vsqlshow(ByVal Osel As String)
Dim sql, vstring As String
Dim c As ListItem
Dim vdb As Boolean
Dim rs As Recordset
Dim vda As String
If Trim$(Osel) = "" Then
vda = DateAdd("m", -2, Date)
Osel = "where c.vdate > #" & vda & "#"
End If
MSFzy.Clear
Call showTital
sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
"insurance_info as a,car_info as b,lp as c " & Osel & " and a.serial=b.serial and a.serial=c.id order by c.vdate desc"
'sql = "select * from lp " & Osel & " order by vdate desc"
vdb = ExcSql
If vdb = True Then
Set rs = conn.Execute(sql)
If Not rs.EOF Then
Do While Not rs.EOF
vstring = rs("d19") & "◆◆" & rs("d10") & "◆◆" & rs("d19") & "◆◆" & rs("d2") & "◆◆" & rs("d3") & "◆◆" _
& rs("d4") & "◆◆" & rs("d5") & "◆◆" & rs("d6") & "◆◆" & rs("d8") & "◆◆" & rs("d9") & "◆◆" _
& rs("d11") & "◆◆" & rs("d12") & "◆◆" & rs("d13") & "◆◆" & rs("d14") & "◆◆" & rs("d17") & "◆◆" _
& rs("d16") & "◆◆" & rs("d15") & "◆◆" & rs("d18") & "◆◆"
' vstring = rs("id") & "◆◆" & rs("name") & "◆◆" & rs("tel") & "◆◆" & rs("bbx") & "◆◆" _
' & rs("btel") & "◆◆" & rs("carn") & "◆◆" & rs("changn") & "◆◆" & rs("vdate") & "◆◆" & rs("xname") & "◆◆" _
' & rs("sfee") & "◆◆" & rs("pfee") & "◆◆" & rs("myd") & "◆◆" & rs("ja") & "◆◆"
Call AddRowInFlex(FlpNew.MSFzy, vstring)
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
End If
Timer1.Enabled = False
Call Form_Resize
End Sub
Private Sub isButton11_Click()
Call printDate(FlpNew.MSFzy)
End Sub
Private Sub isButton12_Click()
Unload Me
End Sub
Private Sub isButton3_Click()
Load FlpAdd
'FlpAdd.SetFocus
FlpAdd.Show
End Sub
Private Sub isButton4_Click()
Call MSFzyDelMsg(MSFzy.TextMatrix(MSFzy.Row, 0))
Call vsqlshow("")
Call Form_Resize
End Sub
Private Sub isButton8_Click()
Dim sql, vstring As String
Dim vdb As Boolean
Dim rs As Recordset
MSFzy.Clear
Call showTital
'sql = "select * from lp where name='" & Trim$(Tselmsg.Text) & "'"
sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
"insurance_info as a,car_info as b,lp as c where b.serial=c.id and a.serial=c.id and a.bpeo='" & Trim$(Tselmsg.Text) & "'"
vdb = ExcSql
If vdb = True Then
Set rs = conn.Execute(sql)
If Not rs.EOF Then
GoTo showmsg
Exit Sub
End If
'sql = "select * from lp where tel='" & Trim$(Tselmsg.Text) & "'"
sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
"insurance_info as a,car_info as b,lp as c where b.serial=c.id and a.serial=c.id and a.email='" & Trim$(Tselmsg.Text) & "'"
Set rs = conn.Execute(sql)
If Not rs.EOF Then
GoTo showmsg
Exit Sub
End If
'sql = "select * from lp where carn='" & Trim$(Tselmsg.Text) & "'"
sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
"insurance_info as a,car_info as b,lp as c where b.serial=c.id and a.serial=c.id and b.cph='" & Trim$(Tselmsg.Text) & "'"
Set rs = conn.Execute(sql)
If Not rs.EOF Then
GoTo showmsg
Exit Sub
Else
MsgBox "您搜寻的信息不存在!"
Call vsqlshow("")
End If
End If
Exit Sub
showmsg:
Do While Not rs.EOF
vstring = rs("d19") & "◆◆" & rs("d10") & "◆◆" & rs("d19") & "◆◆" & rs("d2") & "◆◆" & rs("d3") & "◆◆" _
& rs("d4") & "◆◆" & rs("d5") & "◆◆" & rs("d6") & "◆◆" & rs("d8") & "◆◆" & rs("d9") & "◆◆" _
& rs("d11") & "◆◆" & rs("d12") & "◆◆" & rs("d13") & "◆◆" & rs("d14") & "◆◆" & rs("d17") & "◆◆" _
& rs("d16") & "◆◆" & rs("d15") & "◆◆" & rs("d18") & "◆◆"
Call AddRowInFlex(FlpNew.MSFzy, vstring)
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Call Form_Resize
End Sub
Private Sub MSFzy_DblClick()
Select Case MSFzy.Col
Case 16
Call showCombox(FlpNew.Cbo, 4)
Call MSFDblClicksel(FlpNew.MSFzy, FlpNew.Cbo)
Case 15
Call showCombox(FlpNew.Cbo, 5)
Call MSFDblClicksel(FlpNew.MSFzy, FlpNew.Cbo)
Case 1
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case 10
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case 11
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case 12
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case 13
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case 14
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case 17
Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
Case Else
Exit Sub
End Select
TS.Text = MSFzy.TextMatrix(MSFzy.Row, MSFzy.Col)
Ts1.Text = MSFzy.Row
Ts2.Text = MSFzy.Col
End Sub
Private Sub MSFzy_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu pu1
Else
' If ((Cbo.Visible = True) Or (Tinsert.Visible = True)) Then
'
' MSFzy.Row = Ts1.Text
' MSFzy.Col = Ts2.Text
'
' Select Case Ts2.Text
' Case 15
' If Trim$(Cbo.Text) <> TS.Text Then
' Call Tinsert_KeyPress(13)
' End If
' Case 16
' If Trim$(Cbo.Text) <> TS.Text Then
' Call Tinsert_KeyPress(13)
' End If
' Case Else
' ' MsgBox Tinsert.Text
' If Trim$(Tinsert.Text) <> TS.Text Then
' Call Tinsert_KeyPress(13)
'
' End If
' End Select
Call MSFMouseDown(FlpNew.Tinsert)
Call MSFMouseDownSel(FlpNew.Cbo)
' End If
End If
End Sub
Private Sub Timer1_Timer()
Call vsqlshow("")
End Sub
Private Sub MSFzy_KeyPress(KeyAscii As Integer)
Select Case MSFzy.Col
Case 15
Call MSFKeyPresssel(KeyAscii, FlpNew.MSFzy, FlpNew.Cbo)
Case 16
Call MSFKeyPresssel(KeyAscii, FlpNew.MSFzy, FlpNew.Cbo)
Case Else
Call MSFKeyPress(KeyAscii, FlpNew.MSFzy, FlpNew.Tinsert)
End Select
End Sub
Private Sub MSFzy_RowColChange()
If MSFzy.Col = 15 Or MSFzy.Col = 16 Then
Call MSFRowColChangeSel(FlpNew.MSFzy, FlpNew.Cbo)
Else
Call MSFRowColChange(FlpNew.MSFzy, FlpNew.Tinsert)
End If
End Sub
Private Sub MSFzy_LeaveCell()
Call MSFLeaveCell(FlpNew.MSFzy)
End Sub
Private Sub Tinsert_KeyPress(KeyAscii As Integer)
'文本框起输入编辑框的作用,模拟网格单元,输入到文本框的内容,经过处理送到网格中,
'当输入完后按回车键可以自动到下一列,若为最后一列,跳转到下一行的第一列等待输入。
Dim sql, vmsg As String
Dim Tablef As String
On err GoTo vnextgo:
If KeyAscii = 13 Then
Select Case MSFzy.Col
Case 1
Tablef = "vdate"
vmsg = Tinsert.Text
Case 10
Tablef = "xname"
vmsg = Tinsert.Text
Case 11
Tablef = "xltel"
vmsg = Tinsert.Text
Case 12
Tablef = "sfee"
vmsg = Tinsert.Text
Case 13
Tablef = "pfee"
vmsg = Tinsert.Text
Case 14
Tablef = "mark"
vmsg = Tinsert.Text
Case 15
Tablef = "ja"
vmsg = Cbo.Text
Case 16
Tablef = "myd"
vmsg = Cbo.Text
Case 17
Tablef = "other"
vmsg = Tinsert.Text
Case Else
'MsgBox "非法的操作方法,请查看帮助系统!"
Exit Sub
End Select
If MSFzy.Col = 1 Or MSFzy.Col = 10 Or MSFzy.Col = 11 Or MSFzy.Col = 12 Or MSFzy.Col = 13 Or MSFzy.Col = 14 Or MSFzy.Col = 15 Or MSFzy.Col = 16 Or MSFzy.Col = 17 Then
If MsgBox("你确定将" & MSFzy.Text & "修改为:<< " & vmsg & " >> 么?", vbYesNo, "确认提示") = vbYes Then
sql = "update lp set " & Tablef & "='" & vmsg & "' where id='" & MSFzy.TextMatrix(MSFzy.Row, 0) & "'"
'MsgBox sql
Call ExcSqlCZ(sql)
Else
GoTo vnextgo
End If
Else
Exit Sub
End If
If MSFzy.Col = 15 Or MSFzy.Col = 16 Then
MSFzy.Text = Cbo.Text
Else
MSFzy.Text = Tinsert.Text
End If
vnextgo:
Tinsert.Visible = False
MSFzy.SetFocus
If MSFzy.Col < (MSFzy.Cols - 1) Then
MSFzy.Col = MSFzy.Col + 1
ElseIf MSFzy.Row < MSFzy.Rows - 1 Then
MSFzy.Row = MSFzy.Row + 1
MSFzy.Col = 0
End If
KeyAscii = 0
End If
End Sub
Private Sub MSFzyDelMsg(keyCheck As String)
Dim sql As String
If MsgBox("你确定将" & MSFzy.TextMatrix(MSFzy.Row, 2) & "的所有信息都删除么?", vbYesNo, "确认提示") = vbYes Then
sql = "delete from lp where id='" & MSFzy.TextMatrix(MSFzy.Row, 0) & "'"
Call ExcSqlCZ(sql)
Call vsqlshow("")
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -