使用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