联系人信息查询系统\列表框关联文本框示例

时　间:2014-11-17 10:11:53
作　者:邓会强   ID：4589  城市：焦作
摘　要:在文本框中输入联系人信息所包含的数字，单击搜索按钮图片，不论在电话、手机、QQ、邮箱，还是包含在索引中，均可模糊查询。在文本框中输入联系人信息所包含的字母，不区分大小写，单击搜索按钮图片，不论在索引中，还是包含在电话、手机、QQ、邮箱中，均可模糊查询。在文本框中输入联系人信息所包含的汉字，点击搜索按钮图片，不论在索引中，还是包含在电话、手机、QQ、邮箱中，均可模糊查询。
正　文:

 

附   件:

点击下载此软件   (按住shift键不放，再打开数据库可进入设计视图)

 

   本系统是在Windows7环境下，使用Microsoft Access 2010进行开发的。

   对当前数据库进行简单的设置。

   开发过程非常简单，只需要设计一个MAIN表、一个DHQ查询、三个窗体（子窗体SUB、DHQ和主窗体MAIN）和两个模块（JL和PY）。

     所有Access对象如下：

MAIN表包含19个字段，主键ID，数据类型为自动编号，系统自动生成标识；字段BM，数据类型为文本，表示联系人编码，用户可自定义；字段DW，数据类型为文本，表示联系人单位；字段ZW，数据类型为文本，表示联系人职务，也可以用作联系人称谓；字段XM，数据类型为文本，表示联系人姓名；字段PY，数据类型为文本，表示要查询信息的拼音；字段BD，数据类型为文本，表示办公室电话；字段GD，数据类型为文本，表示固定电话；字段ZD，数据类型为文本，表示住宅电话；字段Q1、Q2、Q3，数据类型为文本，表示QQ；字段S1、S2、S3，数据类型为文本，表示手机号码；字段Y1、Y2、Y3，数据类型为文本，表示邮箱；字段SC，数据类型为是/否，表示删除标志。

MAIN表设计视图如下：

DHQ查询的设计主要是为了方便查询和显示，除了MAIN表的字段外，又增加了SY表示索引、CX表示查询、DH表示电话、QQ表示QQ、SJ表示手机、YX表示邮箱。

DHQ查询的SQL语句如下：

Select MAIN.*, [DW] & [ZW] & [Xm] AS SY, [BM] & [DW] & [ZW] & [XM] & [PY] & [BD] & [GD] & [ZD] & [S1] & [S2] & [S3] & [Q1] & [Q2] & [Q3] & [Y1] & [Y2] & [Y3] AS CX, "办电" & [BD] & "；固电" & [GD] & "；宅电" & [ZD] AS DH, [Q1] & "；" & [Q2] & "；" & [Q3] AS QQ, [S1] & "；" & [S2] & "；" & [S3] AS SJ, [Y1] & "；" & [Y2] & "；" & [Y3] AS YX

FROM MAIN

Where (((MAIN.SC)=False));

DHQ查询的设计视图如下：

DHQ子窗体用于录入或编辑联系人信息，记录源为DHQ查询，默认视图为单个窗体，其中ID可见为否；DW、ZW、XM更新后生成PY；SC自动生成，不可编辑；PY是由DW、ZW和XM字段录入后自动生成，可编辑；DH自动生成，不可编辑；QQ自动生成，不可编辑；SJ自动生成，不可编辑；YX自动生成，不可编辑。

DHQ窗体设计视图如下：

DHQ窗体的VBA代码如下：

Option Compare Database

Option Explicit

Private Sub DW_AfterUpdate()

    Dim str As String

    str = Me.DW & Me.ZW & Me.XM

    Me.PY = HZ2PY(str)

End Sub

 

Private Sub ZW_AfterUpdate()

    Dim str As String

    str = Me.DW & Me.ZW & Me.XM

    Me.PY = HZ2PY(str)

End Sub

 

 

Private Sub XM_AfterUpdate()

    Dim str As String

    str = Me.DW & Me.ZW & Me.XM

    Me.PY = HZ2PY(str)

End Sub

SUB子窗体用于显示要查询的所有联系人信息的索引，记录源为DHQ查询，默认视图为连续窗体，只有一个文本框SY。

SUB窗体不含VBA代码。

SUB窗体设计视图如下：

MAIN窗体是系统主窗体，可以完成所有操作，记录源为DHQ查询，默认视图为单个窗体，包含一个按钮（Editcmd）用于切换两个子窗体、两个子窗体（SUB和DHQ窗体）、六个标签（RS标签用于显示查询结果、其他五个标签用来显示字段的标题）、六个文本框（SRCH用来输入查询的条件、其他五个文本框用来显示所查询的联系人信息）、六幅图片（一幅背景图片、其他五幅图片用来作为按钮对记录进行定位或查询）。

MAIN窗体的设计视图如下：

MAIN窗体的VBA代码如下：

Option Compare Database

Option Explicit

 

Private Sub Form_Load()

    DoCmd.RunCommand acCmdAppMinimize

    Set Me.SUB.Form.Recordset = Me.Recordset

    Me.RS.Caption = RecordNum(Me)

    Me.DataEntry = False

    Me.DHQ.Visible = False

    Me.Image42.Visible = False

    Me.Image43.Visible = False

    Me.SUB.Visible = True

End Sub

 

Private Sub Form_Close()

    Application.Quit acQuitSaveAll

End Sub

 

Private Sub Editcmd_Click()

    If Me.Image42.Visible = False Then

        Me.Image42.Visible = True

        Me.Image43.Visible = True

    Else

        Me.Image42.Visible = False

        Me.Image43.Visible = False

    End If

End Sub

 

 

Private Sub Image8_Click()

    On Error Resume Next

    If Me.SUB.Visible = True Then

        Me.SUB.SetFocus

    Else

        Me.DHQ.SetFocus

    End If

    Me.Recordset.MoveFirst

    If Me.SUB.Visible = True Then

        Me.SUB!XM.SelLength = 0

    End If

End Sub

 

Private Sub Image9_Click()

    On Error Resume Next

    If Me.SUB.Visible = True Then

        Me.SUB.SetFocus

    Else

        Me.DHQ.SetFocus

    End If

    Me.Recordset.MovePrevious

    If Me.SUB.Visible = True Then

        Me.SUB!XM.SelLength = 0

    End If

End Sub

 

Private Sub Image10_Click()

    On Error Resume Next

    If Me.SUB.Visible = True Then

        Me.SUB.SetFocus

    Else

        Me.DHQ.SetFocus

    End If

    Me.Recordset.MoveNext

    If Me.SUB.Visible = True Then

        Me.SUB!XM.SelLength = 0

    End If

End Sub

 

Private Sub Image11_Click()

    On Error Resume Next

    If Me.SUB.Visible = True Then

        Me.SUB.SetFocus

    Else

        Me.DHQ.SetFocus

    End If

    Me.Recordset.MoveLast

    If Me.SUB.Visible = True Then

        Me.SUB!XM.SelLength = 0

    End If

End Sub

 

Private Sub Image19_Click()

    On Error Resume Next

    If Me.SUB.Visible = False Then

        Me.DataEntry = False

        Me.SUB.Visible = True

        Me.DHQ.Visible = False

        Me.SUB.SetFocus

    End If

    If Nz(Me.srch) <> "" Then

        If IsNull(DLookup("CX", "DHQ", "CX Like '*" & Me.srch & "*'")) Then

            MsgBox "找不到包含“" & Me.srch & "”的信息！"

            Me.srch = ""

            Exit Sub

        End If

   

        Me.RecordSource = "select * from DHQ where CX Like '*" & Me.srch & "*'"

    Else

        Me.RecordSource = "DHQ"

    End If

    Set Me.SUB.Form.Recordset = Me.Recordset

    Me.RS.Caption = RecordNum(Me)

    Me.Requery

    If Me.SUB.Visible = True Then

        Me.SUB.SetFocus

        Me.SUB!XM.SelLength = 0

    Else

        Me.DHQ.SetFocus

    End If

End Sub

 

Private Sub Image42_Click()

    On Error Resume Next

    Me.DataEntry = True

    Me.SUB.Visible = False

    Me.DHQ.Visible = True

    Me.DHQ.SetFocus

End Sub

 

Private Sub Image43_Click()

    On Error Resume Next

    Me.DHQ.Visible = True

    Me.DHQ.SetFocus

    Me.SUB.Visible = False

End Sub

JL模块VBA代码如下：

Option Compare Database

Option Explicit

Function RecordNum(frmData As Form) As String

    On Error Resume Next

    frmData.RecordsetClone.MoveLast

    DoEvents

    RecordNum = "共" & frmData.RecordsetClone.RecordCount & "项记录！"

End Function

PY模块VBA代码如下：

Option Compare Database

Option Explicit

Public Function HZ2PY(Tstr As String, Optional onlyFirst As Boolean) As String

    On Error GoTo Err

    If onlyFirst Then Tstr = Left(Tstr, 1)

    Dim intTstrLong As Integer

    Dim strPY As String

    Dim i As Long, p As Integer

    For intTstrLong = 1 To Len(Tstr)

         i = Asc(Mid(Tstr, intTstrLong, 1))

        If i <= Asc("啊") or i >= Asc("座") Then

            strPY = strPY & Mid(Tstr, intTstrLong, 1)

         Else

    If i >= Asc("啊") And i < Asc("芭") Then p = 65

    If i >= Asc("芭") And i < Asc("擦") Then p = 66

    If i >= Asc("擦") And i < Asc("搭") Then p = 67

    If i >= Asc("搭") And i < Asc("蛾") Then p = 68

    If i >= Asc("蛾") And i < Asc("发") Then p = 69

    If i >= Asc("发") And i < Asc("噶") Then p = 70

    If i >= Asc("噶") And i < Asc("哈") Then p = 71

    If i >= Asc("哈") And i < Asc("击") Then p = 72

    If i >= Asc("击") And i < Asc("喀") Then p = 74

    If i >= Asc("喀") And i < Asc("垃") Then p = 75

    If i >= Asc("垃") And i < Asc("妈") Then p = 76

    If i >= Asc("妈") And i < Asc("拿") Then p = 77

    If i >= Asc("拿") And i < Asc("哦") Then p = 78

    If i >= Asc("哦") And i < Asc("啪") Then p = 79

    If i >= Asc("啪") And i < Asc("欺") Then p = 80

    If i >= Asc("欺") And i < Asc("然") Then p = 81

    If i >= Asc("然") And i < Asc("撒") Then p = 82

    If i >= Asc("撒") And i < Asc("塌") Then p = 83

    If i >= Asc("塌") And i < Asc("挖") Then p = 84

    If i >= Asc("挖") And i < Asc("昔") Then p = 87

    If i >= Asc("昔") And i < Asc("压") Then p = 88

    If i >= Asc("压") And i < Asc("匝") Then p = 89

    If i >= Asc("匝") And i <= Asc("座") Then p = 90

           strPY = strPY & Chr(p)

        End If

    Next intTstrLong

    HZ2PY = strPY

    Exit Function

 Err:

    MsgBox Err.Number & Err.Description

End Function

系统运行效果如下：

1、启动系统Access主窗口最小化，只显示MAIN窗体。

    2、使用最前、后退、前进、最后四个图片按钮可定位所需要查询的联系人信息。

3、在文本框中输入联系人信息所包含的数字，单击搜索按钮图片，不论在电话、手机、QQ、邮箱，还是包含在索引中，均可模糊查询。

4、在文本框中输入联系人信息所包含的字母，不区分大小写，单击搜索按钮图片，不论在索引中，还是包含在电话、手机、QQ、邮箱中，均可模糊查询。

5、在文本框中输入联系人信息所包含的汉字，点击搜索按钮图片，不论在索引中，还是包含在电话、手机、QQ、邮箱中，均可模糊查询。

6、单击背景图片中大X中间的小按钮，可显示修改和新增按钮以及DHQ子窗体，并隐藏SUB子窗体，对选定的联系人信息进行修改，也可以新增联系人信息；单击搜索按钮可显示SUB子窗体、隐藏DHQ子窗体，重返查询状态；再单击X中间的小按钮，可隐藏修改和新增按钮。

Access软件网QQ交流群 (群号:483923997) 　　　　　　Access源码网店