⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmgrzkhedit.frm

📁 朋友给的
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
            TabIndex        =   33
            Top             =   3300
            Width           =   1695
         End
         Begin VB.Label Label38 
            Caption         =   "电子邮件"
            Height          =   375
            Left            =   -74400
            TabIndex        =   32
            Top             =   3960
            Width           =   1695
         End
         Begin VB.Label Label37 
            Caption         =   "手    机"
            Height          =   375
            Left            =   -69960
            TabIndex        =   31
            Top             =   3300
            Width           =   1695
         End
         Begin VB.Label Label36 
            Caption         =   "家庭住址"
            Height          =   375
            Left            =   -69960
            TabIndex        =   30
            Top             =   3960
            Width           =   1695
         End
         Begin VB.Label Label35 
            Caption         =   "生    日"
            Height          =   375
            Left            =   -69960
            TabIndex        =   29
            Top             =   4620
            Width           =   1695
         End
         Begin VB.Label Label22 
            Caption         =   "家庭电话"
            Height          =   375
            Left            =   -74400
            TabIndex        =   28
            Top             =   4620
            Width           =   1695
         End
         Begin VB.Label Label20 
            Caption         =   "个人爱好"
            Height          =   375
            Left            =   -74400
            TabIndex        =   27
            Top             =   5220
            Width           =   1695
         End
         Begin VB.Label Label19 
            Caption         =   "性    格"
            Height          =   375
            Left            =   -69960
            TabIndex        =   26
            Top             =   5220
            Width           =   1695
         End
         Begin VB.Label Label18 
            Caption         =   "婚姻情况"
            Height          =   375
            Left            =   -74400
            TabIndex        =   25
            Top             =   5820
            Width           =   1695
         End
      End
   End
End
Attribute VB_Name = "frmGRZKHEDIT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Command1_Click()
Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    If BDHTH = "" Then
    Exit Sub
    Else
    strsql = "select * from khjbzl where XH='" & XH & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
      If Not rs.EOF Then
      If MsgBox("确定删除身份证号为：" & BDHTH & " 的客户资料？", vbYesNo, "修改询问") = vbNo Then
            Exit Sub
           End If
           End If
           rs.Delete
    ClearText
    End If
End Sub

Private Sub Command2_Click()
Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
   On Error GoTo ErrHandle
   
   If DWMC = "" Then
        MsgBox "姓名不能为空！！", vbInformation, "系统提示"
        Exit Sub
    End If
   
   
   
   
    strsql = "select * from khjbzl where XH='" & XH & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
    If Not rs.EOF Then
        If MsgBox("确定修改身份证号为：" & XH & " 的个人资料？", vbYesNo, "修改询问") = vbNo Then
            Exit Sub
           End If
    Else
        rs.AddNew
    End If
  rs.Fields("DWMC") = Trim(DWMC)
  rs.Fields("FZRXB") = Trim(FZRXB)
  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)
  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("BDHTH") = Trim(BDHTH)
  rs.Fields("TBXZ") = Trim(XH)
  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("czy") = gUser
  rs.Fields("khlx") = 0
    rs.Update
    MsgBox "保存成功!!", vbInformation, "系统提示"
    Call Form_Load
    Exit Sub
    
ErrHandle:
    MsgBox Err.Description, "系统提示"

End Sub


Private Sub Command3_Click()
    Unload Me
End Sub

Private Sub Command4_Click()
Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim msg As String
    Dim strsql As String
    
    strsql = "select 姓名,身份证号 from  VIEWGR"
    If Trim(Findbt) <> "" And Trim(findnr) <> "" Then
        strsql = strsql & " where " & Findbt & "='" & findnr & "' and 操作员='" & gUser & "'"
    Else
    strsql = "select 姓名,身份证号 from  VIEWGR where 操作员='" & gUser & "'"
    End If
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
  
    If rs.RecordCount > 0 Then
'        Call FillText(Findbt, findnr)
'    ElseIf rs.RecordCount > 1 Then
        msg = ShowListView(ListView1, rs, False, "1000,2000")
    Else
        ClearText
        MsgBox "无记录", vbOKOnly, "系统提示"
    End If
End Sub



Private Sub findnr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
KL.Tab = 0
Command4_Click
End If
End Sub

Private Sub Form_Load()
    If Me.WindowState = 0 Then Me.Move 0, 0, 14385, 8325
'    Me.WindowState = 1
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim i As Long
    rs.Open "select * from VIEWGR where 操作员='" & gUser & "'", gCnn, adOpenStatic, adLockReadOnly
    Findbt.Clear
    For i = 0 To rs.Fields.count - 2
        Findbt.AddItem rs.Fields(i).name
    
    
    Next
    
    Dim msg As String
    Dim strsql As String
    If rs.State = 1 Then rs.Close
    strsql = "select 姓名,身份证号 from  VIEWGR where 操作员='" & gUser & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
  
    If rs.RecordCount > 0 Then
        msg = ShowListView(ListView1, rs, False, "1000,2000")
    End If
    
    
    
    
    
    
    
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 = ""

End Sub

Private Sub findnr_Click()
findnr = ""
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 VIEWGR "
    strsql = strsql & " where " & Trim(CODE1) & " like '%" & Trim(CODE2) & "%'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
         DWMC = rs("姓名")
        FZRXB = rs("性别")
        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("性格")
        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 ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
 Dim i As Long
    If ListView1.ListItems.count > 0 Then
        For i = 1 To ListView1.ListItems.count
            If ListView1.ListItems(i).Selected Then
            Call FillText1(ListView1.ListItems(i).Text)
            End If
        Next
        
        
        
    End If
    
End Sub
Private Sub FillText1(CODE2 As String)
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    On Error GoTo ErrHandle
    strsql = "select * from VIEWGR "
    strsql = strsql & " where 姓名 ='" & Trim(CODE2) & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
         DWMC = rs("姓名")
        FZRXB = rs("性别")
        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("性格")
        JBR = rs("婚姻情况")
        JBRXB = rs("子女情况")
        JBRNL = rs("保险需求")
        JBRXL = rs("收入情况")
        JBRZW = rs("预算")
        JBRZW = rs("拜访情况")
        JBRCZ = rs("状态")
        JBRSJ = rs("竞争对手")
        JBREMAIL = rs("焦点分析")
        BDHTH = rs("保单合同号")
        TBXZ = rs("投保险种")
        BXF = rs("保险费")
        BXQX = rs("保险期限")
        TBRQ = rs("投保日期")
        SXRQ = rs("生效日期")
        XBRQ = rs("续保日期")
        
        
        
        End If
    Exit Sub
ErrHandle:
        MsgBox Err.Description, vbCritical, "系统提示"
    
End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -