使用 VBA 在 Access 2010 中的窗体上显示记录集

Question

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

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

Answer 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 窗口的左上角。

Answer 2

我认为您需要执行以下操作才能获得此类功能。

您首先需要在表单上创建足够的正确控件来处理每种可能的情况。然后，您需要将表单设置为数据表表单，以便它显示为网格。

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

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

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

这是一个完美的解决方案吗？肯定不是。 Access 没有任何东西可以与.Net 中的DataGridView 甚至VB6 中使用的网格控件相比。在我看来，您确实在突破 Access 的限制来尝试获得此类功能。就像逆流而上一样。你会发现你所做的一切都会相当困难，有些事情根本不可能。

Answer 3

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

您必须使用表单的 OpenArgs 属性将 ADO 记录集的 SQL 语句传递到表单。下面的代码显示了调用\打开表单（它像查询一样显示 ADO 记录集）并传递 sql 字符串的 VBA 代码。表单加载事件上的 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

Answer 4

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

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

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

对我来说这非常有效（Windows 7 pro ×64 / MS Office pro ×64）