frmywedit.frm

朋友给的

         TabIndex        =   41
         Top             =   3630
         Width           =   1050
      End
      Begin VB.Label Label18 
         Caption         =   "总手续费"
         Height          =   375
         Left            =   4005
         TabIndex        =   40
         Top             =   4200
         Width           =   1050
      End
      Begin VB.Label Label17 
         Caption         =   "业务员佣金"
         Height          =   375
         Left            =   4005
         TabIndex        =   39
         Top             =   3645
         Width           =   1050
      End
      Begin VB.Label Label16 
         Caption         =   "考核佣金折算"
         Height          =   375
         Left            =   330
         TabIndex        =   38
         Top             =   4200
         Width           =   1320
      End
      Begin VB.Label Label15 
         Caption         =   "被保险人"
         Height          =   375
         Left            =   330
         TabIndex        =   37
         Top             =   1935
         Width           =   1050
      End
      Begin VB.Label Label14 
         Caption         =   "投保人"
         Height          =   375
         Left            =   330
         TabIndex        =   36
         Top             =   3065
         Width           =   1050
      End
      Begin VB.Label Label13 
         Caption         =   "交费方式"
         Height          =   375
         Left            =   4005
         TabIndex        =   35
         Top             =   3090
         Width           =   1050
      End
      Begin VB.Label Label12 
         Caption         =   "业务类别"
         Height          =   375
         Left            =   330
         TabIndex        =   34
         Top             =   2500
         Width           =   1050
      End
      Begin VB.Label Label3 
         Caption         =   "保单合同号"
         Height          =   375
         Left            =   330
         TabIndex        =   25
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label4 
         Caption         =   "保险期限"
         Height          =   255
         Left            =   4005
         TabIndex        =   24
         Top             =   1989
         Width           =   735
      End
      Begin VB.Label Label5 
         Caption         =   "投保日期"
         Height          =   255
         Left            =   330
         TabIndex        =   23
         Top             =   925
         Width           =   855
      End
      Begin VB.Label Label6 
         Caption         =   "投保险种"
         Height          =   255
         Left            =   4005
         TabIndex        =   22
         Top             =   2520
         Width           =   735
      End
      Begin VB.Label Label7 
         Caption         =   "保 险 费"
         Height          =   375
         Left            =   4005
         TabIndex        =   21
         Top             =   925
         Width           =   855
      End
      Begin VB.Label Label8 
         Caption         =   "生效日期"
         Height          =   255
         Left            =   4005
         TabIndex        =   20
         Top             =   1497
         Width           =   735
      End
      Begin VB.Label Label9 
         Caption         =   "续保日期"
         Height          =   375
         Left            =   330
         TabIndex        =   19
         Top             =   1425
         Width           =   1050
      End
      Begin VB.Label Label10 
         Caption         =   "其他约定"
         Height          =   375
         Left            =   330
         TabIndex        =   18
         Top             =   4665
         Width           =   1095
      End
   End
End
Attribute VB_Name = "frmYWEDIT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim BXDH As String
Public BXGSID1 As Long
Public ZKHID1 As String
'Public SFZH As String


Private Sub BBXR_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub BDHTH_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub BXF_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub BXQX_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub Command1_Click()

Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
   Dim rs1 As ADODB.Recordset
    Set rs1 = New ADODB.Recordset
    Dim strsql1 As String
On Error GoTo ErrHandle
    If Trim(BDHTH) = "" Then
        MsgBox "保单合同号不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Val(BXF) = 0 Then
        MsgBox "保险费必须为数字且不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(BBXR) = "" Then
        MsgBox "被保险人不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(BXQX) = "" Then
        MsgBox "保险期限不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(YWLB) = "" Then
        MsgBox "业务类别不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(TBXZ) = "" Then
        MsgBox "投保险种不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(TBR) = "" Then
        MsgBox "投保人不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(JFFS) = "" Then
        MsgBox "交费方式不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(YWY) = "" Then
        MsgBox "业务员不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(YWYYJ) = "" Then
        MsgBox "业务员佣金不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(KHYJ) = "" Then
        MsgBox "考核佣金折算比率不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    If Trim(ZSXF) = "" Then
        MsgBox "总手续费不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
    strsql = "select * from BXYW where BDHTH='" & BDHTH & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
    If Not rs.EOF Then
        If MsgBox("保单合同号为：" & BDHTH & "已经存在，是否确定修改？", vbYesNo) = vbNo Then
            Exit Sub
        End If
    Else
        If MsgBox("确定添加保单合同号为：" & BDHTH & "的记录？", vbYesNo) = vbNo Then
            Exit Sub
        Else
            rs.AddNew
        End If
    End If
    rs.Fields("BXGSID") = BXGS.ItemData(BXGS.ListIndex)
    BXGSID1 = BXGS.ItemData(BXGS.ListIndex)
    rs.Fields("YHID") = ZKHID1
    'ZKHID1 = SFZH
    rs.Fields("BDHTH") = BDHTH
    rs.Fields("BXQX") = BXQX
    rs.Fields("TBRQ") = TBRQ
    rs.Fields("TBXZ") = TBXZ
    rs.Fields("BXF") = Val(BXF)
    rs.Fields("SXRQ") = SXRQ
    rs.Fields("XBRQ") = XBRQ
    rs.Fields("QTYD") = QTYD
    rs.Fields("bbxr") = Trim(BBXR)
    rs.Fields("ywlb") = Trim(YWLB)
    rs.Fields("tbr") = Trim(TBR)
    rs.Fields("jffs") = Trim(JFFS)
    rs.Fields("ywy") = Left(Trim(YWY), 4)
    rs.Fields("ywyyj") = Val(YWYYJ)
    rs.Fields("khyj") = Val(KHYJ)
    rs.Fields("zsxf") = Val(ZSXF)
    rs.Fields("czy") = gUser
    rs.Update
    MsgBox "保存成功", vbOKOnly, "系统提示"
    Command4.Enabled = False
    Command5.Enabled = True
    
    frmbdysyf.Show
'    Unload frmYWEDIT
'    clearTXT

    Exit Sub
    
ErrHandle:
    MsgBox Err.Description, vbCritical, "系统提示"
        
        
End Sub
Private Sub ClearTXT()
    BDHTH = ""
    BXF = ""
    BBXR = ""
    BXGS = ""
    YH = ""
    BXQX = ""
    YWLB = ""
    TBXZ = ""
    TBR = ""
    JFFS = ""
    YWY = ""
    YWYYJ = ""
    KHYJ = ""
    ZSXF = ""
    QTYD = ""
    




End Sub
Private Sub Command2_Click()
    Unload Me
End Sub





Private Sub Command4_Click()
    gCnn.Execute "delete from bxyw where bdhth='" & BXDH & "'"
    ClearText
    Command4.Enabled = False
    Call Command3_Click
End Sub

Private Sub Command5_Click()
    frmFJGL.Show
End Sub

Private Sub findnr_Click()
findnr = ""

End Sub

Private Sub findnr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Command3_Click
End Sub

Private Sub Command3_Click()
Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim msg As String
    Dim strsql As String
    
    strsql = "select 保单合同号 from  VIEWbxyw"
    If Trim(findbt) <> "" And Trim(findnr) <> "" Then
        strsql = strsql & " where " & findbt & " like '%" & findnr & "%'"
    End If
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
  
    If rs.RecordCount = 1 Then
        Call FillText(findbt, findnr)
        ListView1.ColumnHeaders.Clear
    ElseIf rs.RecordCount > 1 Then
        msg = ShowListView(ListView1, rs, False, "3000")
    Else
        ClearText
  'MsgBox "无记录", vbOKOnly, "系统提示"
    End If
   
End Sub
Private Sub ClearText()
BXGS = ""
YH = ""
BDHTH = "'"
BXQX = "'"
TBRQ = Now
TBXZ = ""
BXF = "'"
SXRQ = Now
XBRQ = Now
QTYD = ""
HTQX = Now
End Sub

Private Sub FillText(code1 As String, code2 As String)
    
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    strsql = "select * from  VIEWbxyw where " & code1 & " like '%" & code2 & "%'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
        BDHTH = rs("保单合同号")