プロシージャ自身の名前を示すPROC_NAME定数を更新する

DevUtilities.vba

Option Explicit

'vbeProcedureオブジェクトを作成してそれらのコレクションを返す
'モジュール中のコードを解析し、モジュール内のプロシージャ情報をリストアップする
Private Function getProcedures(codeMod As CodeModule) As Collection
    Dim StartLine As Long
    Dim ProcName As String
    Dim lastProcName As String
    Dim lastProcKind As vbext_ProcKind
    Dim procs As New Collection
    Dim proc As vbeProcedure
    Dim ProcKind As vbext_ProcKind

    Dim i As Long

'   Option句の行の省略
    StartLine = codeMod.CountOfDeclarationLines + 1

    '各プロシージャの最初行でオブジェクトを作成しコレクションに追加
    For i = StartLine To codeMod.CountOfLines
        ProcName = codeMod.ProcOfLine(i, ProcKind)
        If ProcName <> lastProcName Or ProcKind <> lastProcKind Then
            Set proc = New vbeProcedure
            proc.initialize ProcName, codeMod, ProcKind
            procs.Add proc
            lastProcName = ProcName
            lastProcKind = ProcKind
        End If
    Next
    Set getProcedures = procs

End Function

'Const PROC_NAME = "プロシージャ名"を更新する。
Private Sub fixProcNameConstants(codeMod As CodeModule)
    Dim procs As Collection
    Dim proc As vbeProcedure
    Dim i As Long

    'プロシージャ情報を管理するオブジェクトコレクションを取得
    Set procs = getProcedures(codeMod)
    
    Debug.Print
    For Each proc In procs
        With proc
            Debug.Print .ProcKind, .StartLine, .CountOfLines, .EndLine, .ParentModule, .Name
            For i = .StartLine + 1 To .EndLine
                If InStr(1, .ParentModule.Lines(i, 1), "Const PROC_NAME", vbTextCompare) Then
'                    Debug.Print .ParentModule.Lines(i, 1)
                    .ParentModule.ReplaceLine i, "Const PROC_NAME As String = " & Chr(34) & .Name & Chr(34)
'                    Debug.Print .ParentModule.Lines(i, 1)
                    Exit For
                End If
            Next
        End With
    Next
End Sub

'全てのPROC_NAMEを更新する
'・モジュール中に「Const PROC_NAME = ""」の記載がある時、
'　ダブルクォーテーション内のプロシージャ名を現時点の名前に更新する
'・ただしDevUtilitiesモジュールは除く
Public Sub FixAllProcNameConstants()
    Dim prj As VBProject
    Set prj = Application.VBE.ActiveVBProject
    
    Dim codeMod As CodeModule
    Dim vbComp As VBComponent

    For Each vbComp In prj.VBComponents
        Set codeMod = vbComp.CodeModule
        If Not codeMod.Name = "DevUtilities" Then
            fixProcNameConstants codeMod
        End If
    Next
End Sub

vbeProcedure.vba

' Class: vbeProcedure
' requires Microsoft Visual Basic for Applications Extensibility 5.3 library
' Author: Christopher J. McClellan
' Creative Commons Share Alike and Attribute license
'   http://creativecommons.org/licenses/by-sa/3.0/

Option Explicit

Private Const vbeProcedureError As Long = 3500

Private mParentModule As CodeModule
Private isParentModSet As Boolean

Private mName As String
Private isNameSet As Boolean

Private mProcKind As vbext_ProcKind
Private isProcKindSet As Boolean

Public Property Get Name() As String
    If isNameSet Then
        Name = mName
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let Name(ByVal vNewValue As String)
    If Not isNameSet Then
        mName = vNewValue
        isNameSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get ProcKind() As String
    If isProcKindSet Then
        ProcKind = mProcKind
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let ProcKind(ByVal vNewValue As String)
    If Not isProcKindSet Then
        mProcKind = vNewValue
        isProcKindSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get ParentModule() As CodeModule
    If isParentModSet Then
        Set ParentModule = mParentModule
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let ParentModule(ByRef vNewValue As CodeModule)
    If Not isParentModSet Then
        Set mParentModule = vNewValue
        isParentModSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get StartLine() As Long
    If isParentModSet And isNameSet Then
        StartLine = Me.ParentModule.ProcStartLine(Me.Name, Me.ProcKind)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get EndLine() As Long
    If isParentModSet And isNameSet Then
        EndLine = Me.StartLine + Me.CountOfLines
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get CountOfLines() As Long
    If isParentModSet And isNameSet Then
        CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, Me.ProcKind)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Sub initialize(Name As String, codeMod As CodeModule, ProcKind As vbext_ProcKind)
    Me.Name = Name
    Me.ParentModule = codeMod
    Me.ProcKind = ProcKind
End Sub

Public Property Get Lines() As String
    If isParentModSet And isNameSet Then
        Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Private Sub RaiseObjectNotIntializedError()
    Err.Raise vbObjectError + vbeProcedureError + 10, ThisWorkbook.Name & "." & TypeName(Me), "Object Not Initialized"
End Sub

Private Sub RaiseReadOnlyPropertyError()
    Err.Raise vbObjectError + vbeProcedureError + 20, ThisWorkbook.Name & "." & TypeName(Me), "Property is Read-Only after initialization"
End Sub

https://stackoverflow.com/questions/23945321/how-to-get-the-procedure-or-function-name-at-runtime

• StackOverflowのソースコードの不完全な箇所を整備
• Access用コードからExcel用コードへ変更