MacroOptionsの表示

Question

Excel/VBAでは、MacroOptions関数を使用して、マクロまたは関数に関連する情報を定義することができます。 VBA経由で入力した情報にアクセスすることは可能ですか？ありがとうございました

Answer 1

私はしばらく検索してきましたが、何も素晴らしいものは見つかりませんでした。

私が見つけた唯一の回避策は、チップピアソンによって構築されたコードを使用して、his websiteに記載されています。

このコードでは、プロシージャに関する一般的な情報を得ることができます。

Public Enum ProcScope 
    ScopePrivate = 1 
    ScopePublic = 2 
    ScopeFriend = 3 
    ScopeDefault = 4 
End Enum 

Public Enum LineSplits 
    LineSplitRemove = 0 
    LineSplitKeep = 1 
    LineSplitConvert = 2 
End Enum 

Public Type ProcInfo 
    ProcName As String 
    ProcKind As VBIDE.vbext_ProcKind 
    ProcStartLine As Long 
    ProcBodyLine As Long 
    ProcCountLines As Long 
    ProcScope As ProcScope 
    ProcDeclaration As String 
End Type 

Function ProcedureInfo(ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _ 
    CodeMod As VBIDE.CodeModule) As ProcInfo 

    Dim PInfo As ProcInfo 
    Dim BodyLine As Long 
    Dim Declaration As String 
    Dim FirstLine As String 


    BodyLine = CodeMod.ProcStartLine(ProcName, ProcKind) 
    If BodyLine > 0 Then 
     With CodeMod 
      PInfo.ProcName = ProcName 
      PInfo.ProcKind = ProcKind 
      PInfo.ProcBodyLine = .ProcBodyLine(ProcName, ProcKind) 
      PInfo.ProcCountLines = .ProcCountLines(ProcName, ProcKind) 
      PInfo.ProcStartLine = .ProcStartLine(ProcName, ProcKind) 

      FirstLine = .Lines(PInfo.ProcBodyLine, 1) 
      If StrComp(Left(FirstLine, Len("Public")), "Public", vbBinaryCompare) = 0 Then 
       PInfo.ProcScope = ScopePublic 
      ElseIf StrComp(Left(FirstLine, Len("Private")), "Private", vbBinaryCompare) = 0 Then 
       PInfo.ProcScope = ScopePrivate 
      ElseIf StrComp(Left(FirstLine, Len("Friend")), "Friend", vbBinaryCompare) = 0 Then 
       PInfo.ProcScope = ScopeFriend 
      Else 
       PInfo.ProcScope = ScopeDefault 
      End If 
      PInfo.ProcDeclaration = GetProcedureDeclaration(CodeMod, ProcName, ProcKind, LineSplitKeep) 
     End With 
    End If 

    ProcedureInfo = PInfo 

End Function 


Public Function GetProcedureDeclaration(CodeMod As VBIDE.CodeModule, _ 
    ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _ 
    Optional LineSplitBehavior As LineSplits = LineSplitRemove) 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' GetProcedureDeclaration 
' This return the procedure declaration of ProcName in CodeMod. The LineSplitBehavior 
' determines what to do with procedure declaration that span more than one line using 
' the "_" line continuation character. If LineSplitBehavior is LineSplitRemove, the 
' entire procedure declaration is converted to a single line of text. If 
' LineSplitBehavior is LineSplitKeep the "_" characters are retained and the 
' declaration is split with vbNewLine into multiple lines. If LineSplitBehavior is 
' LineSplitConvert, the "_" characters are removed and replaced with vbNewLine. 
' The function returns vbNullString if the procedure could not be found. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Dim LineNum As Long 
    Dim S As String 
    Dim Declaration As String 

    On Error Resume Next 
    LineNum = CodeMod.ProcBodyLine(ProcName, ProcKind) 
    If Err.Number <> 0 Then 
     Exit Function 
    End If 
    S = CodeMod.Lines(LineNum, 1) 
    Do While Right(S, 1) = "_" 
     Select Case True 
      Case LineSplitBehavior = LineSplitConvert 
       S = Left(S, Len(S) - 1) & vbNewLine 
      Case LineSplitBehavior = LineSplitKeep 
       S = S & vbNewLine 
      Case LineSplitBehavior = LineSplitRemove 
       S = Left(S, Len(S) - 1) & " " 
     End Select 
     Declaration = Declaration & S 
     LineNum = LineNum + 1 
     S = CodeMod.Lines(LineNum, 1) 
    Loop 
    Declaration = SingleSpace(Declaration & S) 
    GetProcedureDeclaration = Declaration 


End Function 

Private Function SingleSpace(ByVal Text As String) As String 
    Dim Pos As String 
    Pos = InStr(1, Text, Space(2), vbBinaryCompare) 
    Do Until Pos = 0 
     Text = Replace(Text, Space(2), Space(1)) 
     Pos = InStr(1, Text, Space(2), vbBinaryCompare) 
    Loop 
    SingleSpace = Text 
End Function 

あなたは、次のようなコードを使用してProcedureInfo関数を呼び出すことができます。

Sub ShowProcedureInfo() 
    Dim VBProj As VBIDE.VBProject 
    Dim VBComp As VBIDE.VBComponent 
    Dim CodeMod As VBIDE.CodeModule 
    Dim CompName As String 
    Dim ProcName As String 
    Dim ProcKind As VBIDE.vbext_ProcKind 
    Dim PInfo As ProcInfo 

    CompName = "modVBECode" 
    ProcName = "ProcedureInfo" 
    ProcKind = vbext_pk_Proc 

    Set VBProj = ActiveWorkbook.VBProject 
    Set VBComp = VBProj.VBComponents(CompName) 
    Set CodeMod = VBComp.CodeModule 

    PInfo = ProcedureInfo(ProcName, ProcKind, CodeMod) 

    Debug.Print "ProcName: " & PInfo.ProcName 
    Debug.Print "ProcKind: " & CStr(PInfo.ProcKind) 
    Debug.Print "ProcStartLine: " & CStr(PInfo.ProcStartLine) 
    Debug.Print "ProcBodyLine: " & CStr(PInfo.ProcBodyLine) 
    Debug.Print "ProcCountLines: " & CStr(PInfo.ProcCountLines) 
    Debug.Print "ProcScope: " & CStr(PInfo.ProcScope) 
    Debug.Print "ProcDeclaration: " & PInfo.ProcDeclaration 
End Sub