addressbook.frm

简单的通讯录程序

   selection = selection + e3
End If

If Check1(3).Value = 1 Then
   If selection <> "" Then
      e4 = ",移动电话1"
   Else
      e4 = "ID,姓名,移动电话1"
   End If
   selection = selection + e4
End If

If Check1(4).Value = 1 Then
   If selection <> "" Then
      e5 = ",移动电话2"
   Else
      e5 = "ID,姓名,移动电话2"
   End If
   selection = selection + e5
End If

If Check1(5).Value = 1 Then
   If selection <> "" Then
      e6 = ",传真"
   Else
      e6 = "ID,姓名,传真"
   End If
   selection = selection + e6
End If

If Check1(6).Value = 1 Then
   If selection <> "" Then
      e7 = ",电子邮件1"
   Else
      e7 = "ID,姓名,电子邮件1"
   End If
   selection = selection + e7
End If

If Check1(7).Value = 1 Then
   If selection <> "" Then
      e8 = ",电子邮件2"
   Else
      e8 = "ID,姓名,电子邮件2"
   End If
   selection = selection + e8
End If

If Check1(8).Value = 1 Then
   If selection <> "" Then
      e9 = ",联系地址1"
   Else
      e9 = "ID,姓名,联系地址1"
   End If
   selection = selection + e9
End If

If Check1(9).Value = 1 Then
   If selection <> "" Then
      e10 = ",分组"
   Else
      e10 = "ID,姓名,分组"
   End If
   selection = selection + e10
End If

If Check1(11).Value = 1 Then
   If selection <> "" Then
      e12 = ",邮政编码"
   Else
      e12 = "ID,姓名,邮政编码"
   End If
   selection = selection + e12
End If

If Check1(10).Value = 1 Then
   If selection <> "" Then
      e11 = ",备注"
   Else
      e11 = "ID,姓名,备注"
   End If
   selection = selection + e11
End If

If selection = "" Then
   selection = "*"
End If

DBSource = "select " + selection + " from address "
Data1.RecordSource = DBSource
Data1.Refresh
Exit Sub
Handcheck:
MsgBox "发生未知错误，该错误已经被程序安全处理", vbCritical, "错误提示"
End Sub



Private Sub Combo1_Validate(Cancel As Boolean)
If Combo1.Text <> "朋友" And Combo1.Text <> "亲戚" And Combo1.Text <> "同事" And Combo1.Text <> "同学" And Combo1.Text <> "其他" Then
   MsgBox "请从以下类别中选取", vbExclamation, "提示"
   Cancel = True
End If
End Sub
Private Sub Combo2_Validate(Cancel As Boolean)
If Combo2.Text <> "朋友" And Combo2.Text <> "亲戚" And Combo2.Text <> "同事" And Combo2.Text <> "同学" And Combo2.Text <> "其他" And Combo2.Text <> "" Then
   MsgBox "请从以下类别中选取", vbExclamation, "提示"
   Cancel = True
End If
End Sub
Private Sub Command1_Click()
Dim i As Integer
For i = 0 To 11 Step 1
    Check1(i).Value = 0
Next i
Data1.Recordset.AddNew
Ctr_Btn (False)
Ctr_Check (False)
Command2.Enabled = True
Command5.Enabled = True
Ctr_Txt1 (True)
Ctr_Label (False)
DBGrid1.Enabled = False
Text1(1).SetFocus
End Sub

Private Sub Command10_Click()
On Error GoTo handler10
If Text2(2).Text <> "" Then
   If search <> "" Then
      s4 = " and ID = " + Text2(2).Text + ""
   Else
      s4 = " ID = " + Text2(2).Text + ""
   End If
   search = search + s4
End If
If Text2(0).Text <> "" Then
   If search <> "" Then
      s1 = " and 姓名 like '*" + Text2(0).Text + "*'"
   Else
      s1 = " 姓名 like '*" + Text2(0).Text + "*'"
   End If
   search = search + s1
End If
If Text2(1).Text <> "" Then
   If search <> "" Then
      s2 = " and 联系地址1 like '*" + Text2(1).Text + "*'"
   Else
      s2 = " 联系地址1 like '*" + Text2(1).Text + "*'"
   End If
   search = search + s2
End If
If Combo2.Text <> "" Then
   If search <> "" Then
      s3 = " and 分组 like '*" + Combo2.Text + "*'"
   Else
      s3 = " 分组 like '" + Combo2.Text + "'"
   End If
   search = search + s3
End If
If search <> "" Then
Data1.RecordSource = DBSource + " where " + search
Else
Data1.RecordSource = DBSource
End If
Data1.Refresh
search = ""
Exit Sub
handler10:
MsgBox "程序发生未知错误，该错误已经被程序安全处理！", vbCritical, "错误提示"
End Sub

Private Sub Command11_Click()
Dim i As Integer
For i = 0 To 2 Step 1
    Text2(i).Text = ""
Next i
Combo2.Text = ""
End Sub

Private Sub Command2_Click()
On Error GoTo handler2
Data1.Recordset.Update
Data1.Refresh
Ctr_Btn (True)
Ctr_Check (True)
Command2.Enabled = False
Command5.Enabled = False
Ctr_Txt1 (False)
Ctr_Label (True)
DBGrid1.Enabled = True
Exit Sub
handler2:
MsgBox "您输入的数据不合法", vbExclamation, "提示"
End Sub

Private Sub Command3_Click()
Dim i As Integer
For i = 0 To 11 Step 1
    Check1(i).Value = 0
Next i
Data1.Recordset.Edit
Ctr_Btn (False)
Ctr_Check (False)
Command2.Enabled = True
Command5.Enabled = True
Ctr_Txt1 (True)
Ctr_Label (False)
DBGrid1.Enabled = False
Text1(1).SetFocus
End Sub

Private Sub Command4_Click()
On Error GoTo handler4
Reply = MsgBox("你确定要删除吗？？？", vbOKCancel, "提示")
If Reply = vbOK Then
   Data1.Recordset.Delete
   Data1.Refresh
End If
Exit Sub
handler4:
MsgBox "数据库中没有数据", vbCritical, "错误"
End Sub

Private Sub Command5_Click()
Data1.Recordset.CancelUpdate
Data1.Recordset.MoveLast
Ctr_Btn (True)
Ctr_Check (True)
Command2.Enabled = False
Command5.Enabled = False
Ctr_Txt1 (False)
Ctr_Label (True)
DBGrid1.Enabled = True
End Sub

Private Sub Command6_Click()
On Error GoTo handler6
Data1.Recordset.MoveFirst
Exit Sub
handler6:
MsgBox "数据库中没有数据", vbCritical, "错误"
End Sub

Private Sub Command7_Click()
On Error GoTo handler7
Data1.Recordset.MovePrevious
If Data1.Recordset.BOF = True Then
   Data1.Recordset.MoveFirst
End If
Exit Sub

handler7:
MsgBox "数据库中没有数据", vbCritical, "错误"
End Sub

Private Sub Command8_Click()
On Error GoTo handler8
Data1.Recordset.MoveNext
If Data1.Recordset.EOF = True Then
   Data1.Recordset.MoveLast
End If
Exit Sub
handler8:
MsgBox "数据库中没有数据", vbCritical, "错误"
End Sub

Private Sub Command9_Click()
On Error GoTo handler9
Data1.Recordset.MoveLast
Exit Sub
handler9:
MsgBox "数据库中没有数据", vbCritical, "错误"
End Sub

Private Sub d1_Click()
Reply = MsgBox("你确定要退出吗？", vbOKCancel, "提示")
If Reply = vbOK Then
   End
End If
End Sub

Private Sub Form_Load()
Data1.DatabaseName = App.Path + "\address97.mdb"
DBSource = "select * from address "
Data1.RecordSource = DBSource
Command2.Enabled = False: Command5.Enabled = False
Ctr_Txt1 (False)
Text1(0).Enabled = False
Text1(0).BackColor = &H80000004
With Combo1
     .AddItem ("亲戚")
     .AddItem ("朋友")
     .AddItem ("同事")
     .AddItem ("同学")
     .AddItem ("其他")
End With
With Combo2
     .AddItem ("亲戚")
     .AddItem ("朋友")
     .AddItem ("同事")
     .AddItem ("同学")
     .AddItem ("其他")
End With
End Sub

Private Sub Ctr_Btn(Flag As Boolean)
Command1.Enabled = Flag: Command2.Enabled = Flag: Command3.Enabled = Flag: Command4.Enabled = Flag: Command5.Enabled = Flag
Command6.Enabled = Flag: Command7.Enabled = Flag: Command8.Enabled = Flag: Command9.Enabled = Flag: Command10.Enabled = Flag
End Sub

Private Sub Ctr_Txt1(Flag As Boolean)
Dim i As Integer
For i = 1 To 12 Step 1
    Text1(i).Enabled = Flag
    If Text1(i).Enabled = True Then
       Text1(i).BackColor = &H80000005
    Else
       Text1(i).BackColor = &H80000004
    End If
    Next i
Combo1.Enabled = Flag
   If Combo1.Enabled = True Then
      Combo1.BackColor = &H80000005
   Else
      Combo1.BackColor = &H80000004
   End If
   
End Sub


Private Sub Check_Exist()
Dim i As Integer
For i = 0 To 12 Step 1
    If Text1(i).Text <> "" Then
       Text1(i).BackColor = &H80FFFF
    Else
       Text1(i).BackColor = &H80000004
    End If
Next i
End Sub
Private Sub Ctr_Label(Flag As Boolean)
Label3.Enabled = Flag
Label4.Enabled = Flag
End Sub
Private Sub Ctr_Check(Flag As Boolean)
Dim i As Integer
For i = 0 To 11 Step 1
    Check1(i).Enabled = Flag
Next i
End Sub


Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
    For i = 0 To 12 Step 1
    Text1(i).BackColor = &HC0FFFF
Next i
Combo1.BackColor = &HC0FFFF
End Sub


Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
    For i = 0 To 12 Step 1
    Text1(i).BackColor = &H80000004
Next i
Combo1.BackColor = &H80000004
End Sub

Private Sub p1_Click()
Dim mse As excel.Application
Dim num, num2 As Integer
Dim colnum As Integer
Dim str(1 To 20) As String
Dim temp(1 To 20) As String
Dim key As String
Set mse = CreateObject("Excel.Application")
mse.Visible = True
mse.Workbooks.Add
num = Data1.Recordset.RecordCount
For i = 1 To 14 Step 1
    On Error GoTo Over
    temp(i) = DBGrid1.Columns(i)
    colnum = i
Next i
Over:     '判断出有多少列
For j = 1 To num Step 1
   Data1.Recordset.AbsolutePosition = j - 1
   For i = 1 To colnum Step 1
       key = Data1.Recordset.Fields(i) & ""
       str(i) = key
       num2 = i
   Next i
   
   For i = 1 To num2 Step 1
       mse.Range(Chr(64 + i) & (j)).Value = str(i)
   Next i
   
Next j

End Sub