对 Microsoft Office 命令栏进行更多编程(3)
2024-07-21 02:23:56
供稿：网友
commandbardocumenter 和 commandbarcontroldocumenter 子例程
在开发命令栏解决方案时，我经常需要获取特定命令栏或命令栏控件的索引、名称或标题。我创建了 commandbardocumenter 和 commandbarcontroldocumenter 子例程，以便将所有命令栏和命令栏控件的公共属性记录在给定的 office 应用程序中。
要运行这些示例，请在 visual basic editor 中将以下代码复制到 microsoft office xp 应用程序的代码模块，然后运行以下子例程之一或两者都运行。屏幕出现提示时，请将结果保存为文本文件 (.txt)。这使结果更容易加载到应用程序（例如 microsoft excel）中以便查看和过滤。
public sub commandbardocumenter()
' 用途：将当前应用程序中有关所有命令栏的信息
' 写入文本文件。
' 您必须先设置对 microsoft 脚本运行时的引用
' (scrrun.dll) 才能使此代码正确运行。
' 注意：此代码仅适用于 microsoft office xp。
dim objcommandbar as office.commandbar
dim strtype as string
dim strposition as string
dim objfilesavedialog as office.filedialog
dim objfso as scripting.filesystemobject
dim objtextstream as scripting.textstream
const save_button as integer = -1
set objfilesavedialog = application.filedialog(msofiledialogsaveas)
objfilesavedialog.title = "将结果另存为"
' 用户单击“保存”按钮。
if objfilesavedialog.show = save_button then
set objfso = new scripting.filesystemobject
set objtextstream = objfso.createtextfile(objfilesavedialog.selecteditems.item(1))
objtextstream.writeline "name" & vbtab & _
"type" & vbtab & _
"enabled" & vbtab & _
"visible" & vbtab & _
"index" & vbtab & _
"position" & vbtab & _
"protection" & vbtab & _
"row index" & vbtab & _
"top" & vbtab & _
"height" & vbtab & _
"left" & vbtab & _
"width"
' 将下一行替换为：
' for each objcommandbar in application.activeexplorer.commandbars _
<- 对于 outlook
' for each objcommandbar in application.vbe.commandbars <- 对于 _
visual basic editor
for each objcommandbar in application.commandbars
select case objcommandbar.type
case msobartypemenubar
strtype = "menu bar"
case msobartypenormal
strtype = "normal"
case msobartypepopup
strtype = "pop-up"
end select
select case objcommandbar.position
case msobarbottom
strposition = "bottom"
case msobarfloating
strposition = "floating"
case msobarleft
strposition = "left"
case msobarmenubar
strposition = "menu bar"
case msobarpopup
strposition = "pop-up"
case msobarright
strposition = "right"
case msobartop
strposition = "top"
end select
select case objcommandbar.protection
case msobarnochangedock
strprotection = "no change dock"
case msobarnochangevisible
strprotection = "no change visible"
case msobarnocustomize
strprotection = "no customize"
case msobarnohorizontaldock
strprotection = "no horizontal dock"
case msobarnomove
strprotection = "no move"
case msobarnoprotection
strprotection = "no protection"
case msobarnoresize
strprotection = "no resize"
case msobarnoverticaldock
strprotection = "no vertical dock"
end select
objtextstream.writeline objcommandbar.name & vbtab & _
strtype & vbtab & _
objcommandbar.enabled & vbtab & _
objcommandbar.visible & vbtab & _
objcommandbar.index & vbtab & _
strposition & vbtab & _
strprotection & vbtab & _
objcommandbar.rowindex & vbtab & _
objcommandbar.top & vbtab & _
objcommandbar.height & vbtab & _
objcommandbar.left & vbtab & _
objcommandbar.width
next objcommandbar
objtextstream.close
msgbox "结果写入 " & objfilesavedialog.selecteditems.item(1) & "."
end if
end sub
sub commandbarcontroldocumenter()
' 用途：将当前应用程序中所有有关命令栏的信息
' 写入文本文件。
' 您必须先设置对 microsoft 脚本运行时的引用
' 才能使此代码正确运行。
' 注意：此代码仅适用于 microsoft office xp。
dim objcommandbar as office.commandbar
dim objcommandbarcontrol as office.commandbarcontrol
dim stroleusage as string
dim strtype as string
dim objfilesavedialog as office.filedialog
dim objfso as scripting.filesystemobject
dim objtextstream as scripting.textstream
const save_button as integer = -1
set objfilesavedialog = application.filedialog(msofiledialogsaveas)
objfilesavedialog.title = "将结果另存为"
' 用户单击“保存”按钮。
if objfilesavedialog.show = save_button then
set objfso = new scripting.filesystemobject
set objtextstream = objfso.createtextfile(objfilesavedialog.selecteditems.item(1))
objtextstream.writeline "id" & vbtab & _
"index" & vbtab & _
"caption" & vbtab & _
"parent" & vbtab & _
"descriptiontext" & vbtab & _
"builtin" & vbtab & _
"enabled" & vbtab & _
"isprioritydropped" & vbtab & _
"oleusage" & vbtab & _
"priority" & vbtab & _
"tag" & vbtab & _
"tooltiptext" & vbtab & _
"type" & vbtab & _
"visible" & vbtab & _
"height" & vbtab & _
"width"
' 将下一行替换为：
' for each objcommandbar in application.activeexplorer.commandbars <- 对于 outlook
' for each objcommandbar in application.vbe.commandbars _
<- 对于 visual basic editor
for each objcommandbar in application.commandbars
for each objcommandbarcontrol in objcommandbar.controls
select case objcommandbarcontrol.oleusage
case msocontrololeusageboth
stroleusage = "both"
case msocontrololeusageclient
stroleusage = "client"
case msocontrololeusageneither
stroleusage = "neither"
case msocontrololeusageserver
stroleusage = "server"
end select
select case objcommandbarcontrol.type
case msocontrolactivex
strtype = "activex"
case msocontrolautocompletecombo
strtype = "auto-complete combo box"
case msocontrolbutton
strtype = "button"
case msocontrolbuttondropdown
strtype = "drop-down button"
case msocontrolbuttonpopup
strtype = "popup button"
case msocontrolcombobox
strtype = "combo box"
case msocontrolcustom
strtype = "custom"
case msocontroldropdown
strtype = "drop-down"
case msocontroledit
strtype = "edit"
case msocontrolexpandinggrid
strtype = "expanding grid"
case msocontrolgauge
strtype = "gauge"
case msocontrolgenericdropdown
strtype = "generic drop-down"
case msocontrolgraphiccombo
strtype = "graphic combo box"
case msocontrolgraphicdropdown
strtype = "graphic drop-down"
case msocontrolgraphicpopup
strtype = "popup graphic"
case msocontrolgrid
strtype = "grid"
case msocontrollabel
strtype = "label"
case msocontrollabelex
strtype = "labelex"
case msocontrolocxdropdown
strtype = "ocx drop-down"
case msocontrolpane
strtype = "pane"
case msocontrolpopup
strtype = "popup"
case msocontrolspinner
strtype = "spinner"
case msocontrolsplitbuttonmrupopup
strtype = "split button mru popup"
case msocontrolsplitbuttonpopup
strtype = "button popup"
case msocontrolsplitdropdown
strtype = "split drop-down"
case msocontrolsplitexpandinggrid
strtype = "split expanding grid"
case msocontrolworkpane
strtype = "work pane"
end select
objtextstream.writeline objcommandbarcontrol.id & _
vbtab & _
objcommandbarcontrol.index & vbtab & _
objcommandbarcontrol.caption & vbtab & _
objcommandbarcontrol.parent.name & vbtab & _
objcommandbarcontrol.descriptiontext & vbtab & _
objcommandbarcontrol.builtin & vbtab & _
objcommandbarcontrol.enabled & vbtab & _
objcommandbarcontrol.isprioritydropped & vbtab & _
stroleusage & vbtab & _
objcommandbarcontrol.priority & vbtab & _
objcommandbarcontrol.tag & vbtab & _
objcommandbarcontrol.tooltiptext & vbtab & _
strtype & vbtab & _
objcommandbarcontrol.visible & vbtab & _
objcommandbarcontrol.height & vbtab & _
objcommandbarcontrol.width
next objcommandbarcontrol
next objcommandbar
objtextstream.close
msgbox "结果写入 " & _
objfilesavedialog.selecteditems.item(1) & "."
end if
end sub
