|
问题：
如何用代码创建“子数据表”使主表每行左面多一个加号？
打开某个表，菜单 -> 插入 -> 子数据表 ，可以插入一个子数据表，实现数据表视图下每行左面有一个加号，单击加号可以展开与当前记录相关的子数据表，该功能如何用 VBA 代码来实现？
回答：
其实本问题在本站(http://access911.net) 上早就有很多文章论述，你只要将多篇文章中的代码组合一下就能实现。以下先给出所有的代码，然后给出参考示例，最后给出所有本站的参考文章。代码比较长，请耐心看完。
新建一个模块，将以下代码复制进去
'===========================================================
' 过程及函数名： RunTest1
' 版本号 ： --
' 说明 ： 演示，调用菜单半自动创建某个表的子数据表
'
' 详细内容请参考以下文章：
' runcommand方法参数列表
' http://access911.net/index.asp?u1=a&u2=78FAB01E13DC
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： --
' 调用演示 ： --
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function RunTest1()
'请将鼠标停留在这里，并按 F5 键运行演示代码
DoCmd.OpenTable "单位"
DoCmd.RunCommand acCmdInsertSubdatasheet
End Function
'===========================================================
' 过程及函数名： RunTest2
' 版本号 ： --
' 说明 ： 演示，调用自定义函数DisplayFieldInfor_DAO
' 列出“单位”的所有属性，包括“子数据表(SubdatasheetName)”属性
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： --
' 调用演示 ： --
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function RunTest2()
'请将鼠标停留在这里，并按 F5 键运行演示代码
'结果将打印在“立即窗口”，按 CTRL + G 可以打开或者关闭立即窗口
DisplayFieldInfor_DAO "单位"
End Function
'===========================================================
' 过程及函数名： RunTest3
' 版本号 ： --
' 说明 ： 演示，调用自定义函数 DelSubdatasheetNameProperty
' 删除“单位”表的“子数据表”
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： --
' 调用演示 ： --
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function RunTest3()
'请将鼠标停留在这里，并按 F5 键运行演示代码
'结果将打印在“立即窗口”，按 CTRL + G 可以打开或者关闭立即窗口
DelSubdatasheetNameProperty "单位"
End Function
'===========================================================
' 过程及函数名： RunTest4
' 版本号 ： --
' 说明 ： 演示，调用自定义函数 SetTableProperty
' 创建“单位”的“子数据表(SubdatasheetName)”，让每一行左面出现加号(+)
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： --
' 调用演示 ： --
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function RunTest4()
'请将鼠标停留在这里，并按 F5 键运行演示代码
'结果将打印在“立即窗口”，按 CTRL + G 可以打开或者关闭立即窗口
Dim tdf As New DAO.TableDef
Dim dbs As DAO.Database
Set dbs = CurrentDb
Set tdf = dbs.TableDefs("单位")
SetTableProperty tdf, "SubdatasheetName", "Table.部门" '设定子数据表为 “部门”
SetTableProperty tdf, "LinkChildFields", "单位编号" '设定链接子字段为“单位编号”
SetTableProperty tdf, "LinkMasterFields", "编号" '设定链接主字段为“编号”
End Function
'--------------------------------------------------------------------
'------ 以上为演示代码，下面是演示代码中需要用到的自定义函数 ------
'--------------------------------------------------------------------
'===========================================================
' 过程及函数名： DelSubdatasheetNameProperty
' 版本号 ： 1.0
' 说明 ： 本函数调用 DAO 删除某个表的子数据表属性
' 引用 ： Microsoft DAO 3.6 Object Library
' 输入参数 ： TableName 文本，填写某个表的名称。
' 输出值 ： --
' 返回值 ： --
' 测试环境 ： 简体中文 Access 2003 + 简体中文 Windows 2003
' 调用演示 ： DelSubdatasheetNameProperty "表1"
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function DelSubdatasheetNameProperty(ByVal TableName As String)
On Error Resume Next
Dim tdf As New DAO.TableDef
Dim dbs As DAO.Database
Set dbs = CurrentDb
Set tdf = dbs.TableDefs(TableName)
tdf.Properties.Delete "LinkChildFields"
tdf.Properties.Delete "LinkMasterFields"
tdf.Properties.Delete "SubdatasheetName"
End Function
'===========================================================
' 过程及函数名： DisplayFieldInfor_DAO
' 版本号 ： 2.0
' 说明 ： 本函数调用 DAO 列出数据库中所有表的所有字段的所有属性的值
' 引用 ： Microsoft DAO 3.6 Object Library
' 输入参数 ： TableName 可选，文本，填写某个表的名称。
' 如果不填写，则列出所有的表
' ListAllField 可选，布尔值。
' True 列出所有的字段；
' False 默认，不列出字段信息。
' 输出值 ： --
' 返回值 ： --
' 测试环境 ： 简体中文 Access 2003 + 简体中文 Windows 2003
' 调用演示 ： DisplayFieldInfor_DAO
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function DisplayFieldInfor_DAO(Optional ByVal TableName As String, _
Optional ByVal ListAllField As Boolean)
On Error Resume Next
Dim tdf As New DAO.TableDef
Dim fld As DAO.Field
Dim p As DAO.Property
For Each tdf In CurrentDb.TableDefs
If TableName = "" Or tdf.Name = TableName Then
'以下代码能够获取在 Access 界面中表中手动进行的排序和筛选的条件
For Each p In tdf.Properties
Debug.Print tdf.Name, p.Name, p.Value
DoEvents
Next
'显示所有字段信息
If ListAllField = True Then
For Each fld In tdf.Fields
For Each p In fld.Properties
Debug.Print "表名:" & tdf.Name, _
"字段名:" & fld.Name, _
"属性名:" & p.Name & _
"属性值:" & p.Value
DoEvents
Next
Next
End If
End If
Next
End Function
'===========================================================
' 过程及函数名： SetTableProperty
' 版本号 ： 2.0
' 说明 ： 本函数调用 DAO ，通过错误陷阱设置或者创建表的属性
' 引用 ： Microsoft DAO 3.6 Object Library
' 输入参数 ： tdf TableDef 对象，需要设定属性的表。
' PropertyName 文本，需要设定或者创建的属性名称。
' valPropertyValue Variant，属性的值。
' 输出值 ： --
' 返回值 ： --
' 测试环境 ： 简体中文 Access 2003 + 简体中文 Windows 2003
' 调用演示 ： SetTableProperty MyTdf,"SubdatasheetName","Table.表1"
' 最后修改日期： 2007-1-3 16:22:00
' 示例地址 ： http://access911.net/?kbid;72FABE1E15DCEBF3
' 作者 ： cg1
' 网站 ： http://access911.net
' 电子邮件 ： access911@gmail.com
' 版权 ： 作者保留一切权力，
' 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Sub SetTableProperty(tdf As DAO.TableDef, _
PropertyName As String, _
valPropertyValue As Variant)
Dim prpNew As Property
Dim errLoop As Error
'尝试设置某个属性，并用错误陷阱捕捉出现的错误
On Error GoTo Err_Property
tdf.Properties(PropertyName) = valPropertyValue
On Error GoTo 0
Exit Sub
Err_Property:
'错误号 3270 表示该属性没有被找到（不存在）
If Err.Number = 3270 Then
'用 CreateProperty 方法建立属性，并设定该属性的值
'然后将新建的属性添加到“表”的属性集合
Debug.Print "未找到" & PropertyName & "现在创建该属性"
Set prpNew = tdf.CreateProperty(PropertyName, dbText, valPropertyValue)
tdf.Properties.Append prpNew
Resume Next
Else
'如果是其他错误，则显示所有的错误消息
For Each errLoop In Errors
MsgBox "Error number: " & errLoop.Number & vbCr & _
errLoop.Description
Next errLoop
End
End If
End Sub
示例下载：
http://access911.net/down/eg/eg_SetSubDatasheet_DAO.rar (19KB)
|
