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

Question

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

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

Answer 1

下面是我认为你必须做的才能获得这种功能。

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

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

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

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

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

Answer 2

您可以将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 3

为ADP项目，你不能有本地的MS Access查询定义，您可以创建名为TXT1多个textboxs，TXT2，.... txt30一个数据表形式和标签名称LBL1 ... LB30和验证码将设置form.recordsource并将textbox.controlsource和label.caption设置为ADO记录集对象的相应字段。此表单将允许您查看类似于Docmd.OpenQuery方法的ADO记录集。

您必须使用窗体的OpenArgs属性将ADO记录集的SQL语句传递给窗体。下面的代码显示了VBA代码来调用\打开表单（显示ADO记录集就像查询）并传递你的sql字符串。在窗体的Load事件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