使用VBA在Access 2010中的窗体上显示记录集
我正在开发Access 2010中的数据检索应用程序,其中用户通过选择列表框条目来选择要查看哪些表,列和行。 VBA代码根据这些选择生成SQL语句,然后从中创建一个ADBDB.Recordset对象。使用VBA在Access 2010中的窗体上显示记录集
如何在Access中显示记录集记录?没有任何网格控件在Access 2010中工作,并且该子窗体并不是为此目的而设计的。有人可以推荐另一种策略?
下面是我认为你必须做的才能获得这种功能。
您首先需要在表单上创建足够的正确控件以处理每种可能的情况。然后,您需要将表单设置为数据表格形式,以便将其显示为网格。
现在将控件的controlsource设置为与记录集中的某个字段相对应。在每个未使用的控件上,都需要将ColumnHidden属性设置为true。您还必须更改关联标签的标题,以显示每个可见控件的适当列名。
现在,将该窗体绑定到您的ADO记录集对象。
Me.Recordset = rst
'or
Me.Subform1.Form.Recordset = rst
这是一个完美的解决方案吗?当然不是。 Access没有任何与.Net中的DataGridView相比,甚至没有任何与VB6中使用的Grid控件相比的东西。在我看来,你真的在推动Access的极限,试图获得这种功能。这就像上游游泳一样。你会发现你所做的一切都会相当困难,有些事情不可能实现。
您可以将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窗口的左上角。
为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
请使用四个空格作为缩进来格式化代码块。 – 2012-10-01 10:26:35
您可以使用ADO来完成这个而不是DAO? – 2011-06-01 19:11:12
我不知道OpenOffice的ADO对象。所以如果你必须使用ADO,我认为你将不得不投入更多的努力。 – HansUp 2011-06-01 20:03:28
为什么要使用ADO?您在Access中工作,其中DAO是本地数据库接口。 – 2011-06-03 03:19:14