frmkuhulogin.frm

一个优秀的售楼系统,可供毕业生毕业设计参考

rs_kehu.Fields(6) = DTPicker1.Value         '出生日期信息
If Trim(txtemail.Text) = "" Then
   rs_kehu.Fields(7) = Null
Else
   rs_kehu.Fields(7) = txtemail.Text
End If
If Trim(txtcard.Text) = "" Then               '车牌号信息
   rs_kehu.Fields(8) = Null
Else
   rs_kehu.Fields(8) = txtcard.Text
End If
If Trim(txtyoubian.Text) = "" Then               '邮编信息
   rs_kehu.Fields(9) = Null
Else
   rs_kehu.Fields(9) = txtyoubian.Text
End If
If Trim(txtadd.Text) = "" Then               '通讯地址信息
   rs_kehu.Fields(10) = Null
Else
   rs_kehu.Fields(10) = txtadd.Text
End If
If Trim(txtbeizhu.Text) = "" Then              '备注信息
   rs_kehu.Fields(11) = Null
Else
   rs_kehu.Fields(11) = txtbeizhu.Text
End If
rs_kehu.Update
MsgBox "添加成功！", vbOKOnly + vbExclamation, "OK"
With gridkehu
     .Rows = rs_kehu.RecordCount + 1
     .Row = gridkehu.Rows - 1
     .Col = 0
     .Text = txtID.Text
     .Col = 1
     .Text = txtname.Text
     .Col = 2
     .Text = Combo1.Text
     .Col = 3
     .Text = txttel.Text
     .Col = 4
     .Text = txtcell.Text
     .Col = 5
     .Text = txtduty.Text
     .Col = 6
     .Text = DTPicker1.Value
     .Col = 7
     .Text = txtemail.Text
     .Col = 8
     .Text = txtcard.Text
     .Col = 9
     .Text = txtyoubian.Text
     .Col = 10
     .Text = txtadd.Text
     .Col = 11
     .Text = txtbeizhu.Text
End With
Else
   cmdadd.Caption = "保存"
   txtID.Text = ""
   txtname.Text = ""
   txttel.Text = ""
   txtcell.Text = ""
   txtyoubian.Text = ""
   txtemail.Text = ""
   txtcard.Text = ""
   txtadd.Text = ""
   txtduty.Text = ""
   txtbeizhu.Text = ""
   cmdmodify.Enabled = False
   cmddel.Enabled = False
End If
Exit Sub
adderror:
   MsgBox Err.Description
End Sub

Private Sub cmdmodify_Click()
On Error GoTo modifyerror
txtID.Enabled = False
If Trim(txtname.Text) = "" Then
   MsgBox "姓名不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txtname.SetFocus
   Exit Sub
End If
rs_kehu.MoveFirst
Dim i As Integer
For i = 0 To rs_kehu.RecordCount - 1
    If rs_kehu.Fields(0) = txtID.Text Then
       rs_kehu.Fields(1) = txtname.Text
       rs_kehu.Fields(2) = Combo1.Text
       If Trim(txttel.Text) = "" Then
          rs_kehu.Fields(3) = Null
       Else
          rs_kehu.Fields(3) = txttel.Text
       End If
       If Trim(txtcell.Text) = "" Then
          rs_kehu.Fields(4) = Null
       Else
          rs_kehu.Fields(4) = txtcell.Text
       End If
       If Trim(txtduty.Text) = "" Then
          rs_kehu.Fields(5) = Null
       Else
          rs_kehu.Fields(5) = txtduty.Text
       End If
       rs_kehu.Fields(6) = DTPicker1.Value
       If Trim(txtemail.Text) = "" Then
          rs_kehu.Fields(7) = Null
       Else
          rs_kehu.Fields(7) = txtemail.Text
       End If
       If Trim(txtcard.Text) = "" Then
          rs_kehu.Fields(8) = Null
       Else
          rs_kehu.Fields(8) = txtcard.Text
       End If
       If Trim(txtyoubian.Text) = "" Then
          rs_kehu.Fields(9) = Null
       Else
          rs_kehu.Fields(9) = txtyoubian.Text
       End If
       If Trim(txtadd.Text) = "" Then
          rs_kehu.Fields(10) = Null
       Else
          rs_kehu.Fields(10) = txtadd.Text
       End If
       If Trim(txtbeizhu.Text) = "" Then
          rs_kehu.Fields(11) = Null
       Else
          rs_kehu.Fields(11) = txtbeizhu.Text
       End If
       rs_kehu.Update
       MsgBox "修改成功！", vbOKOnly + vbExclamation, "OK"
       With gridkehu
          .Row = getrow
          .Col = 1
          .Text = txtname.Text
          .Col = 2
          .Text = Combo1.Text
          .Col = 3
          .Text = txttel.Text
          .Col = 4
          .Text = txtcell.Text
          .Col = 5
          .Text = txtduty.Text
          .Col = 6
          .Text = DTPicker1.Value
          .Col = 7
          .Text = txtemail.Text
          .Col = 8
          .Text = txtcard.Text
          .Col = 9
          .Text = txtyoubian.Text
          .Col = 10
          .Text = txtadd.Text
          .Col = 11
          .Text = txtbeizhu.Text
       End With
       Exit Sub
    End If
    rs_kehu.MoveNext
Next i
modifyerror:
   MsgBox Err.Description
End Sub

Private Sub cmddel_Click()
Dim answer As String
Dim delete_row As String
On Error GoTo delerror
   answer = MsgBox("确定要删除吗？", vbYesNo, "")
   If answer = vbYes Then
       rs_kehu.MoveFirst
       Dim i As Integer
       For i = 0 To rs_kehu.RecordCount - 1
          If rs_kehu.Fields(0) = txtID.Text Then
             rs_kehu.Delete
             rs_kehu.Update
             MsgBox "删除成功！", vbOKOnly + vbExclamation, "OK"
             With gridkehu
                  .RemoveItem getrow
             End With
             Exit Sub
          End If
          rs_kehu.MoveNext
       Next i
  Else
       Exit Sub
  End If
Exit Sub
delerror:
   MsgBox Err.Description
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select * from 客户资料"
rs_kehu.CursorLocation = adUseClient
rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic
setgrid
setgridhead
displaygrid
Combo1.AddItem "男"
Combo1.AddItem "女"
cmdmodify.Enabled = False
cmddel.Enabled = False
gridclick = False
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub

Public Sub displaygrid()
Dim i As Integer
Dim j As Integer
On Error GoTo displayerror
gridkehu.Row = 0
If Not rs_kehu.EOF Then
   rs_kehu.MoveFirst
   Do While Not rs_kehu.EOF
            gridkehu.Row = gridkehu.Row + 1
            For j = 0 To 11
                gridkehu.Col = j
                If Not IsNull(rs_kehu.Fields(j)) Then gridkehu.Text = _
                   rs_kehu.Fields(j) Else gridkehu.Text = ""
            Next j
            rs_kehu.MoveNext
   Loop
End If
displayerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub setgrid()
Dim i As Integer
On Error GoTo seterror
With gridkehu
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_kehu.RecordCount + 1
    .Cols = 12
    .SelectionMode = flexSelectionByRow
For i = 0 To .Rows - 1
    .RowHeight(i) = 315
Next
For i = 0 To .Cols - 1
    .ColWidth(i) = 1500
Next i
End With
Exit Sub
seterror:
     MsgBox Err.Description
End Sub

Public Sub setgridhead()
On Error GoTo setheaderror
gridkehu.Row = 0
gridkehu.Col = 0
gridkehu.Text = "身份证号"
gridkehu.Col = 1
gridkehu.Text = "姓名"
gridkehu.Col = 2
gridkehu.Text = "性别"
gridkehu.Col = 3
gridkehu.Text = "电话"
gridkehu.Col = 4
gridkehu.Text = "手机"
gridkehu.Col = 5
gridkehu.Text = "职业"
gridkehu.Col = 6
gridkehu.Text = "出生日期"
gridkehu.Col = 7
gridkehu.Text = "电子邮件"
gridkehu.Col = 8
gridkehu.Text = "车牌号"
gridkehu.Col = 9
gridkehu.Text = "邮编"
gridkehu.Col = 10
gridkehu.Text = "通信地址"
gridkehu.Col = 11
gridkehu.Text = "备注"
Exit Sub
setheaderror:
   MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
rs_kehu.Close
End Sub

Private Sub gridkehu_Click()
On Error GoTo griderror
gridclick = True
cmdmodify.Enabled = True
cmddel.Enabled = True
getrow = gridkehu.Row
If gridkehu.Rows = 1 Then
   MsgBox "无相关纪录", vbOKOnly + vbExclamation, ""
Else
select_row = gridkehu.TextMatrix(getrow, 0)
displaymingxi
End If
griderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub displaymingxi()
txtID.Text = select_row
txtname.Text = gridkehu.TextMatrix(getrow, 1)
txttel.Text = gridkehu.TextMatrix(getrow, 3)
txtcell.Text = gridkehu.TextMatrix(getrow, 4)
txtyoubian.Text = gridkehu.TextMatrix(getrow, 9)
txtemail.Text = gridkehu.TextMatrix(getrow, 7)
txtcard.Text = gridkehu.TextMatrix(getrow, 8)
txtadd.Text = gridkehu.TextMatrix(getrow, 10)
txtduty.Text = gridkehu.TextMatrix(getrow, 5)
txtbeizhu.Text = gridkehu.TextMatrix(getrow, 11)
Combo1.Text = gridkehu.TextMatrix(getrow, 2)
DTPicker1.Value = CDate(gridkehu.TextMatrix(getrow, 6))
End Sub