【ExcelVBA】VBAコードの情報や概要をシートに一覧出力する

# 概要

個人で作成していたExcelとAccessを用いたツールを、メンバーに引き継ぐ必要が出てきた。
念のため説明書や仕様書などはしっかり作ってきていて、プロシージャ一覧表も作成している。
ただ、全体で1万行近く、300近い関数群を手動でまとめ続けるのがしんどくなってきた。

PythonのDocstringのような仕組みを作りたいと思ったが、
綺麗な仕様書レベルまで仕上げるには時間がなかったのでひとまず一覧表出力の機構だけ作ってみた。

# 仕組み

実行すると、ActiveWorkBookに含まれるプロシージャの一覧がProcsシートに表示される。
Personalブックに入れて実行するために、対象をActiveWorkBookしている。

![01.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/219708/b72d09d1-c375-a451-288d-82558d2fa0fc.png)

あったら嬉しい情報を列項目に設定している。

* モジュール名
* モジュールタイプ
* プロシージャ名
* プロシージャタイプ
* 行数
* 引数
* 戻り値
* 概要

**プロシージャタイプ**、**引数**、**戻り値**は
プロシージャの先頭行から正規表現で抽出している。
間に合わせなので、手元の300関数群で取りこぼしがない状況にはできたが、
拾いきれない書式とかがまだ出てくるかもしれない。
(例えば現状、引数の型指定が書かれていないとアウトだったりする。 As の部分で引っかけたりしているので…)


**概要**は、プロシージャの先頭部分に所定の書式で書いておくと拾ってくれる。
コメントブロックを設定し、10個以上の-(ハイフン)で挟めば良い。

``` vb
Sub ListUpProcs()
'-----------------------------------------------------------------------------------------------------
'【ここが概要になる】
'【ここが概要になる】
'ListUpProcsのメイン処理。
'【ここが概要になる】
'【ここが概要になる】
'-----------------------------------------------------------------------------------------------------

    Dim trgBook As Workbook: Set trgBook = ActiveWorkbook
    Dim trgSheet As Worksheet: Set trgSheet = trgBook.Worksheets.Add
```

これでコードと仕様書を行ったり来たりする手間がだいぶ省けた。コードを変えたら出力してコピペするだけ。
同じ仕組みを流用して、宣言されているけど一度も使われていない変数を見つけ出す処理も考えようと思う。
できればいつかはDocString的なレベルまで発展させてみたい。

# 中身
標準モジュールに貼り付けて、**Sub ListUpProcs()** を実行すれば動くはず。

```vb
Option Explicit
Enum eRecord
    モジュール名 = 1
    モジュールタイプ
    プロシージャ名
    プロシージャタイプ
    行数
    引数
    戻り値
    概要
End Enum

Sub ListUpProcs()
'-----------------------------------------------------------------------------------------------------
'ListUpProcsのメイン処理。
'-----------------------------------------------------------------------------------------------------

    Dim trgBook As Workbook: Set trgBook = ActiveWorkbook
    Dim trgSheet As Worksheet: Set trgSheet = trgBook.Worksheets.Add
    
    On Error GoTo hundler
    trgSheet.Name = "Procs"
    On Error GoTo 0

    'ヘッダーレコードをセットする
    Dim procRecords As Collection: Set procRecords = New Collection
    Dim procRecord(1 To 8) As String 'リストの列数
    procRecord(eRecord.モジュール名) = "モジュール名"
    procRecord(eRecord.モジュールタイプ) = "モジュールタイプ"
    procRecord(eRecord.プロシージャ名) = "プロシージャ名"
    procRecord(eRecord.プロシージャタイプ) = "プロシージャタイプ"
    procRecord(eRecord.行数) = "行数"
    procRecord(eRecord.引数) = "引数"
    procRecord(eRecord.戻り値) = "戻り値"
    procRecord(eRecord.概要) = "概要"
    procRecords.Add procRecord

    'Moduleを順次処理する
    Dim module As Object
    For Each module In trgBook.VBProject.VBComponents
        
        'モジュール名をセットする
        procRecord(eRecord.モジュール名) = module.Name
        
        'モジュールタイプをセットする
        procRecord(eRecord.モジュールタイプ) = FIX_MODULE_TYPE(module)

        'Module内のProcedure一覧をコレクションする
        Dim cModule As Object: Set cModule = module.CodeModule
        Dim procNames As Collection: Set procNames = COLLECT_PROCNAMES_IN_MODULE(cModule)
        
        'Procedureの内容を順次処理する
        Dim procName As Variant, procTop As String
        For Each procName In procNames
        
            'プロシージャ名をセットする
            procRecord(eRecord.プロシージャ名) = procName
            
            'プロシージャの1行目を取得する
            procTop = SET_PROC_TOP(CStr(procName), cModule)
            
            'プロシージャタイプをセットする
            procRecord(eRecord.プロシージャタイプ) = FIX_PROC_TYPE(CStr(procName), procTop)
            
            '行数をセットする
            procRecord(eRecord.行数) = cModule.ProcCountLines(procName, 0)
            
            '引数をセットする
            procRecord(eRecord.引数) = FIX_PROC_ARGS(CStr(procName), procTop)
            
            '戻り値をセットする
            procRecord(eRecord.戻り値) = FIX_PROC_RETURN(CStr(procName), procTop)
            
            '概要をセットする
            procRecord(eRecord.概要) = FIX_PROC_SUMMARY(CStr(procName), cModule)
            
            'レコードをコレクションする
            procRecords.Add procRecord
            
        Next
    Next

    'シートに書き出す
    Dim tmp As Variant, i As Long
    For Each tmp In procRecords
        i = i + 1
        With trgSheet
            .Cells(i, eRecord.モジュール名) = tmp(eRecord.モジュール名)
            .Cells(i, eRecord.モジュールタイプ) = tmp(eRecord.モジュールタイプ)
            .Cells(i, eRecord.プロシージャ名) = tmp(eRecord.プロシージャ名)
            .Cells(i, eRecord.プロシージャタイプ) = tmp(eRecord.プロシージャタイプ)
            .Cells(i, eRecord.行数) = tmp(eRecord.行数)
            .Cells(i, eRecord.引数) = tmp(eRecord.引数)
            .Cells(i, eRecord.戻り値) = tmp(eRecord.戻り値)
            .Cells(i, eRecord.概要) = tmp(eRecord.概要)
        End With
    Next
    

    '見た目を整える
    ActiveWindow.DisplayGridlines = False
    With trgSheet.Cells
        .Font.Name = "Meiryo UI"
        .Font.Size = 9
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop

         '折り返して表示Flse、Trueの順でAutoFitを2度行うとレイアウトをカッチリできる
        .WrapText = False
        .columns.AutoFit
        .Rows.AutoFit
        .WrapText = True
        .columns.AutoFit
        .Rows.AutoFit
    End With

    With trgSheet
        .ListObjects.Add(xlSrcRange, .Cells(1, 1).CurrentRegion, , xlYes).Name = "ProcList"
    End With
    
    Exit Sub
hundler:
    MsgBox "シート名「Procs」が存在しています。"

End Sub

Function COLLECT_PROCNAMES_IN_MODULE(cModule As Object) As Collection
'-----------------------------------------------------------------------------------------------------
'CodeModuleを受け取り、含まれるプロシージャ名の一覧をCollectionで返す。
'-----------------------------------------------------------------------------------------------------

    Dim procNames As Collection: Set procNames = New Collection
    Dim i As Long, buf As String
    For i = 1 To cModule.CountOfLines
        If buf <> cModule.ProcOfLine(i, 0) Then
            buf = cModule.ProcOfLine(i, 0)
            procNames.Add buf
        End If
    Next
    
    Set COLLECT_PROCNAMES_IN_MODULE = procNames
    
End Function

Function FIX_MODULE_TYPE(module As Object) As String
'-----------------------------------------------------------------------------------------------------
'Moduleを受け取りモジュールタイプを文字列で返す。
'-----------------------------------------------------------------------------------------------------

    Select Case module.Type
        Case 1
            FIX_MODULE_TYPE = "標準モジュール"
        Case 2
            FIX_MODULE_TYPE = "クラスモジュール"
        Case 3
            FIX_MODULE_TYPE = "ユーザーフォーム"
        Case 100
            FIX_MODULE_TYPE = "Excelオブジェクト"
        Case Else
            FIX_MODULE_TYPE = module.Type
    End Select
End Function

Function FIX_PROC_TYPE(procName As String, procTop As String) As String
'-----------------------------------------------------------------------------------------------------
'プロシージャの1行目を受け取り、プロシージャタイプを抽出してテキストで返す。
'-----------------------------------------------------------------------------------------------------

    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = " " & procName & "\(.*"
        .IgnoreCase = False
        .Global = True
    End With
    
    FIX_PROC_TYPE = reg.Replace(procTop, "")
    
End Function

Function FIX_PROC_ARGS(procName As String, procTop As String) As String
'-----------------------------------------------------------------------------------------------------
'プロシージャの1行目を受け取り、引数を抽出してテキストで返す。
'複数ある場合はセル内改行を付与する。
'-----------------------------------------------------------------------------------------------------

    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "(.*" & procName & "\()" & "(.*)" & "(\).*)"
        .IgnoreCase = False
        .Global = True
    End With

    Dim tmp As String
    tmp = reg.Replace(procTop, "$2")
    
    If tmp = "" Then
        FIX_PROC_ARGS = "-"
    Else
        FIX_PROC_ARGS = Replace(tmp, ", ", vbLf)
    End If
    
End Function

Function FIX_PROC_RETURN(procName As String, procTop As String) As String
'-----------------------------------------------------------------------------------------------------
'プロシージャの1行目を受け取り、戻り値の型を抽出してテキストで返す。
'-----------------------------------------------------------------------------------------------------

    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "(.*[^\(]\) As )(.*)"
        .IgnoreCase = False
        .Global = True
    End With
    Dim Matches As Variant
    
    Set Matches = reg.Execute(procTop)
    If Matches.Count > 0 Then
        FIX_PROC_RETURN = reg.Replace(procTop, "$2")
    Else
        FIX_PROC_RETURN = "-"
    End If
    
End Function

Function FIX_PROC_SUMMARY(procName As String, cModule As Object) As String
'-----------------------------------------------------------------------------------------------------
'ProcNameとCodeModuleを受け取り、そのプロシージャの概要を文字列で返す。
'-----------------------------------------------------------------------------------------------------

    Dim startRow As Long: startRow = cModule.ProcStartLine(procName, 0)
    Dim lastRow As Long: lastRow = startRow + cModule.ProcCountLines(procName, 0) - 1

    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "'----------.*" 'ハイフン10個で判定
        .IgnoreCase = False
        .Global = True
    End With
    Dim Matches As Variant

    Dim i As Long, tmp As String, checker As Boolean
    For i = startRow To lastRow
        If checker Then
            tmp = tmp & cModule.Lines(i, 1) & vbLf
            Set Matches = reg.Execute(cModule.Lines(i, 1))
            If Matches.Count > 0 Then
                Exit For
            End If
        Else
            Set Matches = reg.Execute(cModule.Lines(i, 1))
            If Matches.Count > 0 Then
                checker = True
            End If
        End If
    Next
    
    tmp = reg.Replace(tmp, "")
    
    If tmp = "" Then
        FIX_PROC_SUMMARY = "-"
    Else
        tmp = Replace(tmp, "'", "")
        FIX_PROC_SUMMARY = Left(tmp, Len(tmp) - 1)
    End If

End Function

Function SET_PROC_TOP(procName As String, cModule As Object) As String
'-----------------------------------------------------------------------------------------------------
'ProcNameとCodeModuleを受け取り、そのプロシージャの1行目の内容を文字列で返す。
'-----------------------------------------------------------------------------------------------------

    Dim startRow As Long: startRow = cModule.ProcStartLine(procName, 0)
    Dim lastRow As Long: lastRow = startRow + cModule.ProcCountLines(procName, 0) - 1

    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = " " & procName & "\(.*"
        .IgnoreCase = False
        .Global = True
    End With
    Dim Matches As Variant
    
    Dim tmp As String, i As Long
    For i = startRow To lastRow
        tmp = cModule.Lines(i, 1)
        Set Matches = reg.Execute(tmp)
        If Matches.Count > 0 Then SET_PROC_TOP = tmp
    Next
End Function

```