概要
個人で作成していたExcelとAccessを用いたツールを、メンバーに引き継ぐ必要が出てきた。
念のため説明書や仕様書などはしっかり作ってきていて、プロシージャ一覧表も作成している。
ただ、全体で1万行近く、300近い関数群を手動でまとめ続けるのがしんどくなってきた。
PythonのDocstringのような仕組みを作りたいと思ったが、
綺麗な仕様書レベルまで仕上げるには時間がなかったのでひとまず一覧表出力の機構だけ作ってみた。
仕組み
実行すると、ActiveWorkBookに含まれるプロシージャの一覧がProcsシートに表示される。
Personalブックに入れて実行するために、対象をActiveWorkBookしている。
あったら嬉しい情報を列項目に設定している。
- モジュール名
- モジュールタイプ
- プロシージャ名
- プロシージャタイプ
- 行数
- 引数
- 戻り値
- 概要
プロシージャタイプ、引数、戻り値は
プロシージャの先頭行から正規表現で抽出している。
間に合わせなので、手元の300関数群で取りこぼしがない状況にはできたが、
拾いきれない書式とかがまだ出てくるかもしれない。
(例えば現状、引数の型指定が書かれていないとアウトだったりする。 As の部分で引っかけたりしているので…)
概要は、プロシージャの先頭部分に所定の書式で書いておくと拾ってくれる。
コメントブロックを設定し、10個以上の-(ハイフン)で挟めば良い。
Sub ListUpProcs()
'-----------------------------------------------------------------------------------------------------
'【ここが概要になる】
'【ここが概要になる】
'ListUpProcsのメイン処理。
'【ここが概要になる】
'【ここが概要になる】
'-----------------------------------------------------------------------------------------------------
Dim trgBook As Workbook: Set trgBook = ActiveWorkbook
Dim trgSheet As Worksheet: Set trgSheet = trgBook.Worksheets.Add
これでコードと仕様書を行ったり来たりする手間がだいぶ省けた。コードを変えたら出力してコピペするだけ。
同じ仕組みを流用して、宣言されているけど一度も使われていない変数を見つけ出す処理も考えようと思う。
できればいつかはDocString的なレベルまで発展させてみたい。
中身
標準モジュールに貼り付けて、Sub ListUpProcs() を実行すれば動くはず。
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