frmgrcbkh.frm

朋友给的

    Exit Sub
ErrHandle:
        MsgBox Err.Description, vbCritical, "系统提示"
    
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
    On Error GoTo ErrHandle
    strsql = "select * from VIEWTBGR "
    strsql = strsql & " where " & Trim(code1) & " like '%" & Trim(code2) & "%'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
         DWMC = rs("姓名")
        If Trim(rs("性别")) = "男" Then
            Option1.Value = True
        Else
            Option2.Value = True
        End If
        FZRNL = rs("年龄")
        XH = rs("身份证号")
        FZRXL = rs("学历")
        JBRJTDH = rs("民族")
        JBRADDRESS = rs("工作单位")
        FZRZW = rs("职务")
        FZRBGDH = rs("办公电话")
        FZRSJ = rs("手机")
        FZREMAIL = rs("电子邮件")
        FZRADDRESS = rs("家庭住址")
        FZRJTDH = rs("家庭电话")
        FZRSR = rs("生日")
        FZRXG = rs("性格")
        FZRGRAH = rs("个人爱好")
        JBR = rs("婚姻情况")
        JBRXB = rs("子女情况")
        JBRNL = rs("保险需求")
        JBRXL = rs("收入情况")
        JBRZW = rs("预算")
        JBRZW = rs("拜访情况")
        JBRCZ = rs("状态")
        JBRSJ = rs("竞争对手")
        JBREMAIL = rs("焦点分析")
        
        End If
    Exit Sub
ErrHandle:
        MsgBox Err.Description, vbCritical, "系统提示"
    
End Sub
Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Command4_Click()
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "select * from TBKHJBZL where xh='" & XH & "'", gCnn, adOpenStatic, adLockPessimistic
 If DWMC = "" Then
        MsgBox "姓名不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
     If XH = "" Then
        MsgBox "身份证号不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
'    If BDHTH = "" Then
'        MsgBox "保单合同号不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
'    If TBXZ = "" Then
'        MsgBox "投保险种不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
'    If BXF = "" Then
'        MsgBox "保险费不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
'    If BXQX = "" Then
'        MsgBox "保险期限不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
If rs.EOF Then
    rs.AddNew
Else
        If MsgBox("确定修改身份证号为：" & XH & " 的个人资料？", vbYesNo, "修改询问") = vbNo Then
            Exit Sub
        End If

End If

   rs.Fields("KHLX") = 0
  rs.Fields("DWMC") = Trim(DWMC)
  rs.Fields("FZRXG") = Trim(FZRXG)
  rs.Fields("FZRNL") = Trim(FZRNL)
  rs.Fields("XH") = Trim(XH)
  rs.Fields("FZRXL") = Trim(FZRXL)
  rs.Fields("JBRJTDH") = Trim(JBRJTDH)
  rs.Fields("JBRADDRESS") = Trim(JBRADDRESS)
  rs.Fields("FZRZW") = Trim(FZRZW)
  rs.Fields("FZRBGDH") = Trim(FZRBGDH)
  rs.Fields("FZRSJ") = Trim(FZRSJ)
  rs.Fields("FZREMAIL") = Trim(FZREMAIL)
  rs.Fields("FZRADDRESS") = Trim(FZRADDRESS)
  rs.Fields("FZRJTDH") = Trim(FZRJTDH)
  rs.Fields("FZRSR") = Trim(FZRSR)
  rs.Fields("FZRGRAH") = Trim(FZRGRAH)
  rs.Fields("FZRXG") = Trim(FZRXG)
  If Option1.Value = True Then
    rs.Fields("fzrxb") = "男"
  Else
    rs.Fields("fzrxb") = "女"
  End If
  rs.Fields("JBR") = Trim(JBR)
  rs.Fields("JBRXB") = Trim(JBRXB)
  rs.Fields("JBRNL") = Trim(JBRNL)
  rs.Fields("JBRXL") = Trim(JBRXL)
  rs.Fields("JBRZW") = Trim(JBRZW)
  rs.Fields("JBRBGDH") = Trim(JBRBGDH)
  rs.Fields("JBRCZ") = Trim(JBRCZ)
  rs.Fields("JBRSJ") = Trim(JBRSJ)
  rs.Fields("JBREMAIL") = Trim(JBREMAIL)
  rs.Fields("czy") = gUser
'  rs.Fields("BDHTH") = Trim(BDHTH)
'  rs.Fields("TBXZ") = Trim(TBXZ)
'  rs.Fields("BXF") = Trim(BXF)
'  rs.Fields("BXQX") = Trim(BXQX)
'  rs.Fields("TBRQ") = Trim(TBRQ)
'  rs.Fields("SXRQ") = Trim(SXRQ)
'  rs.Fields("XBRQ") = Trim(XBRQ)
'  rs.Fields("QTYD") = Trim(QTYD)
      rs.Update
    MsgBox "保存成功", vbOKOnly, "系统提示"
   ClearText
   
    KL.Tab = 0
    Call Form_Load

End Sub
Private Sub LSTKH()


End Sub
Private Sub Form_Load()
    If Me.WindowState = 0 Then Me.Move 0, 0, 13875, 8385
    Dim rs As ADODB.Recordset
    Dim msg As String
    Set rs = New ADODB.Recordset
    Dim i As Long
    rs.Open "select * from VIEWTBGR", gCnn, adOpenStatic, adLockReadOnly
    Findbt.Clear
    For i = 0 To rs.Fields.count - 1
        Findbt.AddItem rs.Fields(i).name
    Next
    If rs.State = 1 Then rs.Close
    strsql = "select 姓名,身份证号 from  VIEWTBGR"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    msg = ShowListView(ListView1, rs, False, "3000,1")
    
    QYLX = 1
    
    KL.Tab = 0
    Command5.Enabled = False

End Sub
Private Sub ClearText()
    DWMC = ""
        FZRXB = ""
        FZRNL = ""
        XH = ""
        FZRXL = ""
        JBRJTDH = ""
        JBRADDRESS = ""
        FZRZW = ""
        FZRBGDH = ""
        FZRSJ = ""
        FZREMAIL = ""
        FZRADDRESS = ""
        FZRJTDH = ""
        FZRSR = Now
        FZRXG = ""
        JBR = ""
        JBRXB = ""
        JBRNL = ""
        JBRXL = ""
        JBRZW = ""
        JBRZW = ""
        JBRCZ = ""
        JBRSJ = ""
        JBREMAIL = ""
BDHTH = ""
XH = ""
BXF = ""
BXQX = ""
'TBRQ = Now
'SXRQ = Now
'XBRQ = Now
End Sub
Private Sub DWMC_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

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

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

End Sub




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

End Sub

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

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

End Sub




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

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

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

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

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

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

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

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

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

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

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

End Sub
Private Sub JBRXB_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
    KL.Tab = 1
    SendKeys "{Tab}"
   End If
End Sub
Private Sub JBRNL_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

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

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

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

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

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

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

End Sub

Private Sub TBXZ_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 BXQ_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

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

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

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

End Sub
Private Sub QTYD_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 XH_LostFocus()
    On Error GoTo err_Handle
'    If cboZjlx.Text = "身份证" Then
        If Trim(XH) = "" Then
            MsgBox "请输入身份证（护照）号！", vbCritical, "系统提示"
            XH.SetFocus
            Exit Sub
        Else
            If Len(Trim(XH)) <> 15 And Len(Trim(XH)) <> 18 Then
                MsgBox "身份证号为15位或者18位！", vbCritical, "系统提示 "
                XH.SetFocus
                Exit Sub
            Else
                If Len(Trim(XH)) = 18 And Right(Trim(XH), 3) <> "000" Then
                   FZRSR = Format(DateSerial(Mid(Trim(XH), 7, 4), Mid(Trim(XH), 11, 2), Mid(Trim(XH), 13, 2)), "yyyy-MM-dd")
                   FZRNL = Year(Date) - Val(Mid(Trim(XH), 7, 4))
                   If Mid(Trim(XH), 17, 1) Mod 2 = 0 Then
                      Option2.Value = True
                   Else
                      Option1.Value = True
                      
                    End If
                Else
                   FZRSR = Format(DateSerial(Mid(Trim(XH), 7, 2), Mid(Trim(XH), 9, 2), Mid(Trim(XH), 11, 2)), "yyyy-MM-dd")
                   
                   If Right(Trim(XH), 3) = "000" Then
                     If Mid(Trim(XH), 15, 1) Mod 2 = 0 Then
                        Option2.Value = True
                     Else
                        Option1.Value = True
                     End If
                  Else
                     If Right(Trim(XH), 1) Mod 2 = 0 Then
                        Option2.Value = True
                     Else
                        Option1.Value = True
                     End If
                  End If
                End If
               End If
            End If
        'End If
        Exit Sub
err_Handle:
    If Err.Number = 13 Then
       MsgBox "确认身份证号是否正确!", vbInformation, "系统提示"
       XH.SetFocus
    Else
       MsgBox Err.Description, vbInformation, "系统提示"
    End If

End Sub