Как получить макросы, определенные в книге Excel.

Question

.

. Есть ли способ в коде VBA или C# получить список существующих макросов, определенных в рабочей книге?

В идеале этот список будет иметь сигнатуры определения метода, но просто получение списка доступных макросов будет отличным.

Возможно ли это?

Answer 1

Я не делал vba для Excel в течение длительного времени, но если я хорошо помню, объектная модель для кода была недоступна через скрипты.

При попытке получить к нему доступ появляется следующее сообщение об ошибке.

Run-time error '1004': 
Programmatic access to Visual Basic Project is not trusted 

Try:

Tools | Macro | Security |Trusted Publisher Tab 
[x] Trust access to Visual Basic Project 

Теперь, когда у вас есть доступ к VB IDE, вы, вероятно, может экспортировать модули и сделать поиск текста в них, используя VBA/C#, используя регулярные выражения, чтобы найти объявления sub и function, а затем удалить экспортированные модули.

Я не уверен, есть ли другой способ сделать это, но это должно сработать.

Вы можете посмотреть следующую ссылку, чтобы начать экспорт модулей. http://www.developersdex.com/vb/message.asp?p=2677&ID=%3C4FCD0AE9-5DCB-4A96-8B3C-F19C63CD3635%40microsoft.com%3E

Здесь я получил информацию о предоставлении надежного доступа к VB IDE.

Answer 2

Основываясь на ответе Мартина, после того как вы доверяете доступу к VBP, вы можете использовать этот набор кода для получения массива всех общедоступных подпрограмм в VB Project книги Excel. Вы можете изменить его, чтобы включать только субтитры или просто funcs, или просто частные или просто общественные ...

Private Sub TryGetArrayOfDecs() 
    Dim Decs() As String 
    DumpProcedureDecsToArray Decs 
End Sub 

Public Function DumpProcedureDecsToArray(ByRef Result() As String, Optional InDoc As Excel.Workbook) As Boolean 
    Dim VBProj As Object 
    Dim VBComp As Object 
    Dim VBMod As Object 

    If InDoc Is Nothing Then Set InDoc = ThisWorkbook 

    ReDim Result(1 To 1500, 1 To 4) 
    DumpProcedureDecsToArray = True 
    On Error GoTo PROC_ERR 

    Set VBProj = InDoc.VBProject 
    Dim FuncNum As Long 
    Dim FuncDec As String 
    For Each VBComp In VBProj.vbcomponents 
     Set VBMod = VBComp.CodeModule 
     For i = 1 To VBMod.countoflines 
      If IsSubroutineDeclaration(VBMod.Lines(i, 1)) Then 
       FuncDec = RemoveBlanksAndDecsFromSubDec(RemoveAsVariant(VBMod.Lines(i, 1))) 
       If LCase(Left(VBMod.Lines(i, 1), Len("private"))) <> "private" Then 
        FuncNum = FuncNum + 1 
        Result(FuncNum, 1) = FindToLeftOfString(InDoc.Name, ".") ' 
        Result(FuncNum, 2) = VBMod.Name 
        Result(FuncNum, 3) = GetSubName(FuncDec) 
        Result(FuncNum, 4) = VBProj.Name 
       End If 
      End If 
     Next i 
    Next VBComp 
PROC_END: 
    Exit Function 
PROC_ERR: 
    GoTo PROC_END 
End Function 

Private Function RemoveCharFromLeftOfString(TheString As String, RemoveChar As String) As String 
    Dim Result As String 
    Result = TheString 
    While LCase(Left(Result, Len(RemoveChar))) = LCase(RemoveChar) 
     Result = Right(Result, Len(Result) - Len(RemoveChar)) 
    Wend 
    RemoveCharFromLeftOfString = Result 
End Function 

Private Function RemoveBlanksAndDecsFromSubDec(TheLine As String) As String 
    Dim Result As String 
    Result = TheLine 
    Result = RemoveCharFromLeftOfString(Result, " ") 
    Result = RemoveCharFromLeftOfString(Result, " ") 
    Result = RemoveCharFromLeftOfString(Result, "Public ") 
    Result = RemoveCharFromLeftOfString(Result, "Private ") 
    Result = RemoveCharFromLeftOfString(Result, " ") 
    RemoveBlanksAndDecsFromSubDec = Result 
End Function 

Private Function RemoveAsVariant(TheLine As String) As String 
    Dim Result As String 
    Result = TheLine 
    Result = Replace(Result, "As Variant", "") 
    Result = Replace(Result, "As String", "") 
    Result = Replace(Result, "Function", "") 
    If InStr(1, Result, "(") = 0 Then 
     Result = Replace(Result, "(", "(") 
    End If 
    RemoveAsVariant = Result 
End Function 

Private Function IsSubroutineDeclaration(TheLine As String) As Boolean 
    If LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("Function "))) = "function " Or LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("sub "))) = "sub " Then 
     IsSubroutineDeclaration = True 
    End If 
End Function 

Private Function GetSubName(DecLine As String) As String 
    GetSubName = FindToRightOfString(FindToLeftOfString(DecLine, "("), " ") 
End Function 

Function FindToLeftOfString(FullString As String, ToFind As String) As String 
    If FullString = "" Then Exit Function 
    Dim Result As String, ToFindPos As Integer 
    ToFindPos = InStr(1, FullString, ToFind, vbTextCompare) 
    If ToFindPos > 0 Then 
     Result = Left(FullString, ToFindPos - 1) 
    Else 
     Result = FullString 
    End If 
    FindToLeftOfString = Result 
End Function 

Function FindToRightOfString(FullString As String, ToFind As String) As String 
    If FullString = "" Then Exit Function 
    Dim Result As String, ToFindPos As Integer 
    ToFindPos = InStr(1, FullString, ToFind, vbTextCompare) 
    Result = Right(FullString, Len(FullString) - ToFindPos + 1 - Len(ToFind)) 
    If ToFindPos > 0 Then 
     FindToRightOfString = Result 
    Else 
     FindToRightOfString = FullString 
    End If 
End Function