自动获得内部菜单项的过程
Access系统中内置的菜单和工具,我们也可以使用,如何获得这些内置菜单,是本小节要解决的问题。
列举菜单项过程的代码如下:
Sub 列举菜单项()
Dim sql1, s
Dim i, a, b
sql1 = "delete * from 内部菜单"
DoCmd.RunSQL (sql1) '删除表中的内容
For Each a In CommandBars
For Each b In a.Controls
Select Case b.Type
Case 1
s = "命令按钮"
Case 3
s = "下拉列表"
Case 4
s = "组合框"
Case 6
s = "拆分下拉列表"
Case 10
For Each c In b.Controls
If Len(Nz(a.Name)) > 1 Then
s = "命令按钮"
sql1 = "Insert INTO 内部菜单(英文名,中文名,菜单标题,菜单类型,菜单说明,菜单ID) VALUES ('" & Nz(a.Name) & "','" & Nz(a.NameLocal) & "--" & Nz(b.Caption) & "','" & Nz(c.Caption) & "','" & s & "','" & Nz(c.TooltipText) & "'," & Nz(c.id) & ")"
DoCmd.RunSQL (sql1)
End If
Next
s = "弹出框"
Case 12
s = "弹出式按钮"
Case 13
s = "拆分按钮弹出框"
Case 14
s = "最近使用弹出框"
Case 16
s = "展开网格"
Case 18
s = "网格"
Case 21
s = "窗格"
Case 21
s = "窗格"
Case 21
s = "窗格"
Case 25
s = "工作窗格"
End Select
If Len(Nz(a.Name)) > 1 Then
sql1 = "Insert INTO 内部菜单(英文名,中文名,菜单标题,菜单类型,菜单说明,菜单ID) VALUES ('" & Nz(a.Name) & "','" & Nz(a.NameLocal) & "','" & Nz(b.Caption) & "','" & s & "','" & Nz(b.TooltipText) & "'," & Nz(b.id) & ")"
DoCmd.RunSQL (sql1)
End If
Next
Next
DoCmd.OpenTable "内部菜单"
End Sub
其中,列举菜单项过程中用到了一个数据表,该标的名称为“内部菜单”,其结构如表21-20所示:
表21-20“内部菜单”表的结构
字段名
|
数据类型
|
字段大小
|
默认值
|
备注及属性设置
|
英文名
|
文本
|
255
|
|
|
中文名
|
文本
|
255
|
|
|
菜单ID
|
数字
|
长整形
|
|
|
菜单标题
|
文本
|
255
|
|
|
菜单类型
|
文本
|
255
|
|
|
菜单说明
|
文本
|
255
|
|
|
执行过程“列举菜单项”,就可以将内部菜单的一些命令保存到“内部菜单”数据表中。