Исходный текст
Option Explicit
Call ExecuteCmd(ThisApplication.Shell.SelObjects)
'=====================================================================
' Создать команду Test, если такой нет в приложении, и выполнить ее
' на заданном объекте.Для выполнения скрипта (создания команды)
' нужны права системного администратора
'=====================================================================
Sub ExecuteCmd(Objects)
If Objects.Count = 0 Then
Msgbox "Нет выделенных объектов.", vbInformation
Exit Sub
End If
Dim Cmd, appCmds, objCmds, Script, OldScript, bExist, CmdID, Object
Set Object = Objects(0)
CmdID = "CMD_TEST2"
Set Cmd = Nothing
'Получить ссылку на коллекцию команд приложения
Set appCmds = ThisApplication.Commands
' Если команда "Test" не найдена в коллекции, создать ее
If Not appCmds.Has(CmdID) Then
Call CreateNewCommand(Cmd, appCmds, CmdID)
bExist = FALSE
Else 'иначе - получить ссылку на существующую команду
Set Cmd = appCmds.Item(CmdID)
bExist = True
End If
'Получить коллекцию команд объекта
Set objCmds = Object.ObjectDef.Commands
'Если команды нет в коллекции, добавить ее
If Not objCmds.Has(Cmd) Then objCmds.Add Cmd
'Выполнить команду (можно и так: appCmds("CMD_TEST").Execute Object)
ThisApplication.ExecuteCommand Cmd, Object
'Если команда создана нами, уничтожить ее
If bExist <> TRUE Then Cmd.Erase
End Sub
'======================================================================
'Создать команду с системным именем CmdID в указанной коллекции
Sub CreateNewCommand(Cmd, WhereToCreate, CmdID)
Dim Script
'Создать команду в коллекции. Независимо от того что это за коллекция
'(объекта, типа, приложения или др) команда автоматически добавляется
'в коллекцию команд приложения
Set Cmd = WhereToCreate.Create
'Дать описание, SysID и иконку
Cmd.Description = "Test Command"
Cmd.SysName = CmdID
Cmd.Icon = ThisApplication.Icons(0)
Cmd.Comments(0) = "Тестовый комментарий"
'Созданная команда будет иметь общий класс и тип "скрипт"
Cmd.Class = tdmCommon
Cmd.Type = tdmVBScript
'Создадим скрипт команды. Он будет включать обработчики событий команды
'и собственно команду - выводить сообщение на экран
Script = "MsgBox ""Выполняется команда """"Test"""".""" & Chr(13) & _
"Sub Command_BeforeExecute(Command, Obj, Cancel)" & Chr(13) & _
" MsgBox ""Команда Test: событие BeforeExecute""" & Chr(13) & _
"End Sub" & Chr(13) & "Sub Command_Completed(Command, Obj)" & Chr(13) & _
" MsgBox ""Команда Test: событие Completed""" & Chr(13) & "End Sub"
'Присвоим команде созданный скрипт
Cmd.Command = Script
'В логах отладчика выводим идентификатор
ThisApplication.DebugPrint("Идентификатор новой команды - " & Cmd.Handle)
End Sub
'======================================================================