http://www.accessoft.com/article-show.asp?id=8543
Public Sub SetParentFormctrls(ByVal frm As Form)
'功能：将子窗体控件数据赋值给主窗体对应控件
Dim ctrls As Controls
Dim ctrl As Control
Set ctrls = frm.Parent.Controls
For Each ctrl In frm.Controls
If ctrl.ControlType <> acLabel Then
ctrls(ctrl.Name).Value = ctrl.Value
End If
Next
End Sub
Public Function ExCtrl(ByVal frm As Form, ByVal ctrlname As String) As Boolean
'功能：判断控件是否存在
Dim B As Boolean
Dim ctrls As Controls
Dim ctrl As Control
Set ctrls = frm.Controls
B = False
For Each ctrl In ctrls
If ctrl.Name = ctrlname Then
B = True
Exit For
End If
Next
ExCtrl = B
End Function
Public Sub InsertTB(ByVal tbname As String, ByVal idfieldname As String, ByVal frm As Form, ByVal subfrm As Form)
'功能：从窗体中的同名控件向数据表追加一条记录
'参数：tbname--表名，idfieldname--主键字段名，frm--窗体名
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
Dim ctrls As Controls
Dim ctrlname As String
On Error Resume Next
Set ctrls = frm.Controls
ssql = "select * from " & tbname
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rs.AddNew
For i = 0 To rs.Fields.Count - 1
ctrlname = rs.Fields(i).Name
If ctrlname <> idfieldname Then
If ExCtrl(frm, ctrlname) Then
rs.Fields(i).Value = ctrls(rs.Fields(i).Name).Value
End If
End If
Next
rs.Update
rs.Close: Set rs = Nothing
subfrm.Requery
subfrm.SelTop = subfrm.RecordsetClone.RecordCount
End Sub
Public Sub UpdateTB(ByVal tbname As String, ByVal idfieldname As String, ByVal frm As Form, ByVal subfrm As Form)
'功能：从窗体中的同名控件向数据表更新一条记录
'参数：tbname--表名，idfieldname--主键字段名，frm--窗体名
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
Dim ctrls As Controls
Dim ctrlname As String
Dim m As Long
On Error Resume Next
m = subfrm.SelTop
Set ctrls = frm.Controls
ssql = "select * from " & tbname & " where cstr(" & idfieldname & ")='" & ctrls(idfieldname).Value & "'"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 0 To rs.Fields.Count - 1
ctrlname = rs.Fields(i).Name
If ctrlname <> idfieldname Then
If ExCtrl(frm, ctrlname) Then
rs.Fields(i).Value = ctrls(rs.Fields(i).Name).Value
End If
End If
Next
rs.Update
rs.Close: Set rs = Nothing
subfrm.Requery
subfrm.SelTop = m
End Sub
Public Sub DeleteTB(ByVal tbname As String, ByVal idfieldname As String, ByVal frm As Form, ByVal subfrm As Form)
'功能：从窗体中的同名控件向数据表删除一条记录
'参数：tbname--表名，idfieldname--主键字段名，frm--窗体名
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
Dim ctrls As Controls
Dim ctrlname As String
On Error Resume Next
Set ctrls = frm.Controls
ssql = "select * from " & tbname & " where cstr(" & idfieldname & ")='" & ctrls(idfieldname).Value & "'"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rs.Delete
rs.Update
rs.Close: Set rs = Nothing
subfrm.Requery
End Sub
