使用 VBA 在 Access 2010 中的表单上显示记录集

Posted 2023-05-07

【中文标题】使用 VBA 在 Access 2010 中的表单上显示记录集

【英文标题】：Displaying a recordset on a form in Access 2010 using VBA

【发布时间】：2011-06-01 00:22:43

【问题描述】：

我正在 Access 2010 中开发一个数据检索应用程序，在该应用程序中，用户通过选择列表框条目来选择要查看的表、列和行。 VBA 代码根据这些选择生成一条 SQL 语句，然后从中创建一个 ADBDB.Recordset 对象。

如何在 Access 中显示记录集记录？ Access 2010 中的所有网格控件都不起作用，并且子窗体不是为此目的而设计的。有人可以推荐其他策略吗？

【参考方案1】：

您可以将 SELECT 语句保存为命名查询，然后将查询作为数据表打开。它不是真正的形式，而是有点像形式。

Call DatasheetFromSql(strSql)

Public Sub DatasheetFromSql(ByVal pSql As String)
    Const cstrQuery As String = "qryDiscardMe"
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim strMsg As String

On Error GoTo ErrorHandler

    Set db = CurrentDb
    db.QueryDefs.Delete cstrQuery
    Set qdf = db.CreateQueryDef(cstrQuery, pSql)
    DoCmd.OpenQuery cstrQuery, , acReadOnly

ExitHere:
    On Error GoTo 0
    Set qdf = Nothing
    Set db = Nothing
    Exit Sub

ErrorHandler:
    Select Case Err.Number
    Case 3265 ' Item not found in this collection. '
        Resume Next
    Case Else
        strMsg = "Error " & Err.Number & " (" & Err.description _
            & ") in procedure DatasheetFromSql"
        MsgBox strMsg
        GoTo ExitHere
    End Select
End Sub

我以只读方式打开了查询。如果您想允许用户编辑他们的自定义查询返回的数据，我不推荐这种方法。相反，我会在 HK1 提供的方法上投入精力，因为它可以支持更好地控制用户数据更改。

查询以数据表形式打开后，您可以使用 Screen.ActiveDatasheet 检查其属性。至少其中一些方法也可供您使用。例如，您可以像这样调整数据表的大小/重新定位：

Screen.ActiveDatasheet.Move Left:=0, Top:=0, Width:=(4 * 1440), Height:=(3 * 1440)

单位是缇（1440 缇/英寸），因此宽度为 4 英寸，高度为 3 英寸，并将其移动到 Access 窗口的左上角。

【讨论】：

你能用 ADO 代替 DAO 吗？

我不知道 OpenQuery 的 ADO 对应项。所以如果一定要使用ADO，我想你要付出更多的努力。

为什么要使用 ADO？您在 Access 中工作，其中 DAO 是本机数据库接口。

【参考方案2】：

这是我认为您必须做的事情才能获得这种功能。

您首先需要在表单上创建足够多的正确控件来处理所有可能的情况。然后，您需要将表单设置为数据表表单，使其显示为网格。

现在将控件上的 controlsource 设置为与记录集中的字段之一相对应。在每个未使用的控件上，都需要将其 ColumnHidden 属性设置为 true。您还必须更改关联标签的标题，以便为每个可见的控件显示适当的列名。

现在，将该表单绑定到您的 ADO 记录集对象。

Me.Recordset = rst
'or
Me.Subform1.Form.Recordset = rst

这是一个完美的解决方案吗？绝对不是。 Access 没有任何东西可以与 .Net 中的 DataGridView 甚至与 VB6 中使用的 Grid 控件相比。在我看来，你真的在​​推动 Access 的极限来尝试获得这种功能。就像逆流而上。你会发现你所做的每件事都会相当困难，有些事情是不可能的。

【参考方案3】：

对于无法拥有本地 MS Access 查询定义的 ADP 项目，您可以创建一个数据表表单，其中包含多个名为 txt1、txt2、.... txt30 和标签名称为 lbl1 ... lb30 的文本框，此代码将设置 form.recordsource 并将 textbox.controlsource 和 label.caption 设置为来自 ADO 记录集对象的适当字段。此表单将允许您查看类似于 Docmd.OpenQuery 方法的 ADO 记录集。

您必须使用表单的 OpenArgs 属性将 ADO 记录集的 SQL 语句传递给表单。下面的代码显示了调用\打开表单的 VBA 代码（它像查询一样显示 ADO 记录集）并传递您的 sql 字符串。表单加载事件上的 vba 代码将设置所有控件属性，调整有数据的列的大小并隐藏 ado 记录集中没有相应字段的列：

'stevekirchner 09/29/2012  Replace Access parameterized query with SQL Server in-line function 
'DoCmd.OpenQuery "qry_SearchMaster_CaseTitles", , acReadOnly

 strsql = "Select * from dbo.UDF__qry_SearchMaster_CaseTitles ('%" & Me.tbxSearchTerm.Value & "%') "

Call Display_ADO_Recordset_from_Datasheet_Form(strsql, "frm_Display_ADO_Recordset_Result1")

'create a non-form module and put the code for the sub Display_ADO_Recordset_from_Datasheet_Form 
'and function fIsLoaded in it (this will allow you make several forms to view ADO recordset and 
'call the code from one place\module):

Sub Display_ADO_Recordset_from_Datasheet_Form(sSQL As String, sFormName As String)

On Error GoTo Error_Handler

    If fIsLoaded(sFormName) Then

        DoCmd.Close acForm, sFormName

    End If

    DoCmd.OpenForm sFormName, acFormDS, , , acFormReadOnly, , OpenArgs:=sSQL

Exit_Sub:

    Exit Sub

Error_Handler:

    MsgBox Err.Description & " Error No: " & CStr(Err.Number)

    Resume Exit_Sub

End Sub

Function fIsLoaded(ByVal strFormname As String) As Boolean

On Error GoTo Error_Handler

    'Returns False if form is not open or True if Open
    If SysCmd(acSysCmdGetObjectState, acForm, strFormname) <> 0 Then

        If Forms(strFormname).CurrentView <> 0 Then
            fIsLoaded = True
        End If

    End If

Exit_Function:

    Exit Function

Error_Handler:

    MsgBox Err.Description & " Error No: " & CStr(Err.Number)

    fIsLoaded = False

    Resume Exit_Function

End Function

'Create a datasheet view form (named frm_Display_ADO_Recordset_Result1) with 30 textboxes and 30
'30 labels named txt1 - txt30 and lbl1 - lbl30 and put this code in the form's module:

Option Compare Database

Private Sub Form_Load()

On Error GoTo Error_Handler

    Dim conn        As ADODB.Connection
    Dim rs          As ADODB.Recordset
    Dim rsClone     As ADODB.Recordset
    Dim strsql      As String

    Set conn = CurrentProject.Connection
    Set rs = New ADODB.Recordset

    strsql = Me.OpenArgs   
    rs.Open strsql, conn, adOpenStatic, adLockOptimistic

    Set rsClone = rs.Clone

    Call Update_Form_Controls("your text goes here", strsql, rsClone)

Exit_Sub:

    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

    Exit Sub

Error_Handler:

    MsgBox Err.Description & "; Error Number : " & Err.Number, vbOKOnly

    Resume Exit_Sub
End Sub

Sub Update_Form_Controls(Header_Label As String, SQL As String, CloneRS As Recordset)

    Dim rsCount As Integer
    Dim i As Integer

On Error GoTo Error_Handler

    Me.Form.Caption = Replace(SQL, "Select * From ", "Display: ")

    rsCount = CloneRS.RecordCount

    If rsCount <= 0 Then

        MsgBox "The Query did not return any data to view", vbOKOnly

        DoCmd.Close
    Else

        Me.Form.SetFocus

        Me.RecordSource = SQL

        i = 1

        Do Until i = 31

            Me("lbl" & i).Caption = ""
            Me("txt" & i).ControlSource = ""
            Me("txt" & i).ColumnHidden = True

            i = i + 1

        Loop

        i = 1

        With CloneRS

        For Each Field In .Fields
        On Error Resume Next

            Me("lbl" & i).Caption = .Fields(i - 1).Name
            Me("txt" & i).ControlSource = .Fields(i - 1).Name
            Me("lbl" & i).Visible = True
            Me("txt" & i).ColumnHidden = False
            Me("txt" & i).SizeToFit

            i = i + 1

            'Debug.Print Field.Name

            On Error GoTo 0
        Next Field
        End With

    End If

Exit_Sub:

    Me.Requery

    Exit Sub


Error_Handler:

    MsgBox Err.Description & "; Error Number : " & Err.Number, vbOKOnly

    Resume Exit_Sub


End Sub

【参考方案4】：

我不使用 ADO，而只是使用 VBA，在这种情况下，上述方法是错误的：不需要任何方法来在表单中显示现有记录集，但相反应该在其中定义足够的记录集 表格！

不用创建MyDataBase.OpenRecordset ("SELECT … [SQL query] ;")，只需将表单的RecordSource设置为相同的查询定义：

Forms![MyDisplayForm].RecordSource = "SELECT … [SQL query] ;" Forms![MyDisplayForm].Requery

对我来说这很完美（Windows 7 pro ×64 / MS Office pro ×64）