Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Какие есть варианты по теме?
Т.е. какими способами можно проверить ошибочность имени макроса до его выполнения командой:
Application.Run "MyProject.MyModule.MyProcedure".
Получить список макросов можно только через CodeModule?
Я вот тоже задумывался над этим. Пришёл к такому варианту получения имён макросов, которые можно запустить, в виде массива:
Public Function GetProceduresNames(vbc As VBComponent) As Variant
Dim myMatch As Object
Dim myMatches As Object
Dim myRegExp As Object
Dim i As Integer, s As String
Set myRegExp = CreateObject("VBScript.RegExp")
With myRegExp
.Pattern = "\bSub\b(.*)\(\)"
.MultiLine = True
.Global = True
End With
Set myMatches = myRegExp.Execute(vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines))
For Each myMatch In myMatches
For i = 1 To myMatch.SubMatches.count
s = s & vbc.Name & "." & Trim(myMatch.SubMatches(i - 1)) & "###"
Next
Next
If Len(s) > 0 Then s = Left(s, Len(s) - 3)
GetProceduresNames = Split(s, "###")
Set myMatch = Nothing
Set myMatches = Nothing
Set myRegExp = Nothing
End Function...задумывался над этим...
Спасибо. Интересный вариант, но по сути та же обработка текста модуля.
Но, ведь где-то Word хранит коллекцию макросов-команд. Например, Word вываливает ошибку 5941 "Запрашиваемый номер семейства не существует" при попытке выполнения кода:
KeysBoundTo KeyCategory:=wdKeyCategoryMacro, Command:="..."Кстати, таким извращенным способом можно проверить правильность команды.
Ты знаешь, я думаю, что сам Word читает имена макросов из бинарного кода файла. Пример, описан сдесь. но он на C++.
На всякий случай, описание формата doc.
Как обстоит дело в случае с XML, я не знаю
...Пришёл к такому варианту получения имён макросов...
Твой вариант не совсем корректный. Например, он вернет как макрос строку кода:
Sub A(A as Byte) ' Sub B()
Хотя такое чудо вряд ли кто напишет. К тому же, он хватает и Private-макросы, а мне нужен был список Alt+F8. Хотя для свойства OnAction подойдет и Private.
Мой вариант:
Public Function Macro_NamesList( _
Optional ByRef SourceVBProject As VBIDE.VBProject = Nothing, _
Optional ByRef ComponentType As VBIDE.vbext_ComponentType = -1, _
Optional ByRef CommandsOnly As Boolean = False) As String
' создание списка макросов активных документов
' SourceVBProject - проект выборки (не задан - все)
' ComponentType - тип модулей выборки (<0 - все)
' CommandsOnly - выборка только команд (список Alt+F8)
' возвращает строку имен макросов разделенных символом vbLf,
' где формат имен: "Проект.Модуль.Макрос"
Macro_NamesList = ""
'On Error Resume Next ' тест
' все проекты
If SourceVBProject Is Nothing Then
For Each SourceVBProject In VBE.VBProjects
GoSub sub_Project
Next SourceVBProject
' заданный проект
Else
GoSub sub_Project
End If
Exit Function
sub_Project: ' выборка из проекта SourceVBProject
With SourceVBProject
' защищенный проект
If .Protection <> VBIDE.vbext_pp_none Then Return
' пустой проект
If .VBComponents.count <= 0 Then Return
' перебор модулей проекта
Dim myComponent As VBIDE.VBComponent
For Each myComponent In .VBComponents
GoSub sub_Component
Next myComponent
End With
Return
sub_Component: ' выборка из модуля myComponent
' тип модуля
If ComponentType < 0 Then
ElseIf myComponent.Type <> ComponentType Then
Return
End If
' командный модуль
If CommandsOnly Then
Select Case myComponent.Type
Case vbext_ct_StdModule
Case vbext_ct_Document
Case Else: Return
End Select
End If
' код модуля
Dim myCode As VBIDE.CodeModule
Dim strMacro As String
Dim iLine&
Set myCode = myComponent.CodeModule
' перебор макросов модуля
For iLine = myCode.CountOfDeclarationLines + 1 To myCode.CountOfLines
' имя макроса
strMacro = myCode.ProcOfLine(Line:=iLine, ProcKind:=vbext_pk_Proc)
' пропуск кода макроса
iLine = iLine + _
myCode.ProcCountLines(ProcName:=strMacro, _
ProcKind:=vbext_pk_Proc)
GoSub sub_Macro
Next iLine
Return
sub_Macro: ' выборка макроса strMacro
If Len(strMacro) <= 0 Then Return
' команда
If CommandsOnly Then
Dim strBodyLine$
strBodyLine = myCode.Lines(myCode.ProcBodyLine(strMacro, vbext_pk_Proc), 1)
If strBodyLine Like "Sub " & strMacro & "()*" Then
ElseIf strBodyLine Like "Public Sub " & strMacro & "()*" Then
ElseIf strBodyLine Like "Static Sub " & strMacro & "()*" Then
ElseIf strBodyLine Like "Public Static Sub " & strMacro & "()*" Then
Else
Return
End If
End If
' сохраняем
If Len(Macro_NamesList) > 0 Then Macro_NamesList = Macro_NamesList & vbLf
Macro_NamesList = Macro_NamesList & _
SourceVBProject.Name & "." & myComponent.Name & "." & strMacro
Return
End FunctionТоже не совсем корректно работает. Выбирает процедуры, даже если стоит строка Option Private Module, т.е. процедуры доступны только для модулей внутри проекта и в списке по Alt+F8 не отображаются.
Да, самому все учесть трудно. Потому я и искал встроенные средства, а то приходится свой миникомпилятор писать 
Многие данные в Word можно считывать из встроенных диалогов без их открытия. Наверно и список Alt+F8 (Dialogs(wdDialogToolsMacro)) можно считать, надо только знать имя аргумента. В документации есть список "Built-in Dialog Box Argument Lists", но он не полный.
внешняя ссылка
внешняя ссылка
пока только это нашел в инете..
внешняя ссылка
внешняя ссылка
внешняя ссылка
поскидываю еще то, что найду, сюда, может пригодятся ссылки
wdDialogToolsMacro
Name, Run, Edit, Show, Delete, Rename, Description, NewName, SetDescсписок именно такой?
Отредактировано andrkar (05.07.2010 17:50:00)
В новом формате файлов имена макросов можно получить, если разобрать файл vbaData.xml
Вот так он выглядит у меня для Normal.dotm, если привести его к удобочитаемому виду, а не в одну строчку:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<wne:vbaSuppData xmlns:ve="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"
xmlns:m="http://schemas.openxmlformats.org/officeDocument/2006/math"
xmlns:v="urn:schemas-microsoft-com:vml"
xmlns:wp="http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing"
xmlns:w10="urn:schemas-microsoft-com:office:word"
xmlns:w="http://schemas.openxmlformats.org/wordprocessingml/2006/main"
xmlns:wne="http://schemas.microsoft.com/office/word/2006/wordml">
<wne:mcds>
<wne:mcd wne:macroName="NORMAL.THISDOCUMENT.OPENCOPYPRINTDELETE"
wne:name="Normal.ThisDocument.OpenCopyPrintDelete"
wne:bEncrypt="00"
wne:cmg="56"/>
<wne:mcd wne:macroName="NORMAL.NEWMACROS.MYRESTARTNUMBERING"
wne:name="Normal.NewMacros.MyRestartNumbering"
wne:bEncrypt="00"
wne:cmg="56"/>
<wne:mcd wne:macroName="NORMAL.NEWMACROS.WHOLETABLEBORDERS"
wne:name="Normal.NewMacros.WholeTableBorders"
wne:bEncrypt="00"
wne:cmg="56"/>
<wne:mcd wne:macroName="NORMAL.NEWMACROS.SAVETOFILES"
wne:name="Normal.NewMacros.SaveToFiles"
wne:bEncrypt="00"
wne:cmg="56"/>
<wne:mcd wne:macroName="NORMAL.THISDOCUMENT.CELLALIGNDECIMAL"
wne:name="Normal.ThisDocument.CellAlignDecimal"
wne:bEncrypt="00"
wne:cmg="56"/>
<wne:mcd wne:macroName="NORMAL.THISDOCUMENT.FILEPRINT"
wne:name="Normal.ThisDocument.FilePrint"
wne:bEncrypt="00"
wne:cmg="56"/>
</wne:mcds>
</wne:vbaSuppData>...список именно такой?...
Да, это список аргументов из документации к VBA.
Список имен всех макросов можно получить с помощью макроса приведенного мной выше.
Для проверки команд я написал две функции. Обе медленные. Первая работает. Вторую писал по мотивам статьи в Интернете, но она работает как-то через раз.
Public Function Macro_CommandValidate( _
ByVal CommandName As String) As Boolean
' возвращает True, если доступен макрос-команда CommandName
Macro_CommandValidate = False
On Error Resume Next
Dim K As KeysBoundTo
Set K = KeysBoundTo(KeyCategory:=Word.wdKeyCategoryMacro, _
Command:=CommandName)
If Err.Number = 0 Then Macro_CommandValidate = True
End Function
Public Function Macro_CommandValidate2( _
ByVal CommandName As String) As Boolean
' возвращает True, если доступен макрос-команда CommandName
Macro_CommandValidate2 = False
With Dialogs(Word.wdDialogToolsMacro)
' Name, Run, Edit, Show, Delete, Rename, Description, NewName, SetDesc
.Name = CommandName
.Run = False
On Error Resume Next
.Execute
If Err.Number = 0 Then Macro_CommandValidate2 = True
End With
End FunctionСтраницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться