Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 人事应用

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

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

点击图片看大图

 

附   件:

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

 

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

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

   开发过程非常简单,只需要设计一个MAIN表、一个DHQ查询、三个窗体(子窗体SUBDHQ和主窗体MAIN)和两个模块(JLPY)。

     所有Access对象如下:

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

MAIN表设计视图如下:

DHQ查询的设计主要是为了方便查询和显示,除了MAIN表的字段外,又增加了SY表示索引、CX表示查询、DH表示电话、QQ表示QQSJ表示手机、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可见为否;DWZWXM更新后生成PYSC自动生成,不可编辑;PY是由DWZWXM字段录入后自动生成,可编辑;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)用于切换两个子窗体、两个子窗体(SUBDHQ窗体)、六个标签(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交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助