Bean用の設計書とコード自動生成

VBAでBean的なものを実装したいわけなんだけれど、
Eclipseならやってくれるアクセサの自動生成を、
VBEはやってくれないのだね。
だから設計書から吐き出してみようか。

※スネークじゃない時の実装漏れた。
修正するからちょっと待って〜

Option Explicit

'---------------------------------------
' 列インデックス
'---------------------------------------
Enum eCol
    NO = 1
    LOGICAL_NAME
    PHYSICAL_NAME
    TYPE_NAME
    OBJ_FLG
    NOTE
End Enum

'---------------------------------------
' 定数
'---------------------------------------
Const GETTER_LETTER_TMP As String = _
      "'-------------------------------------------------------------------------------" & vbCrLf _
    & "' {0} を取得" & vbCrLf _
    & "'-------------------------------------------------------------------------------" & vbCrLf _
    & "Public Property Get get{1}() As {2}" & vbCrLf _
    & "    get{1} = {3}" & vbCrLf _
    & "End Property" & vbCrLf _
    & "'-------------------------------------------------------------------------------" & vbCrLf _
    & "' {0} を設定" & vbCrLf _
    & "'-------------------------------------------------------------------------------" & vbCrLf _
    & "Public Property Let let{1}(ByVal value As {2})" & vbCrLf _
    & "    {3} = value" & vbCrLf _
    & "End Property" & vbCrLf

Const OBJ_GETTER_SETTER_TMP As String = _
      "'-------------------------------------------------------------------------------" & vbCrLf _
    & "' {0} を取得" & vbCrLf _
    & "'-------------------------------------------------------------------------------" & vbCrLf _
    & "Public Property Get get{1}() As {2}" & vbCrLf _
    & "    set get{1} = {3}" & vbCrLf _
    & "End Property" & vbCrLf _
    & "'-------------------------------------------------------------------------------" & vbCrLf _
    & "' {0} を設定" & vbCrLf _
    & "'-------------------------------------------------------------------------------" & vbCrLf _
    & "Public Property Set set{1}(ByVal value As {2})" & vbCrLf _
    & "    Set {3} = value" & vbCrLf _
    & "End Property" & vbCrLf
    
'---------------------------------------------------------------------------------------------------
'【処 理 名】コード自動生成
'【処理概要】アクティブワークシートからVBAのコードを自動生成する。このワークブックと同階層に
'            テキストファイルとして出力する。
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Sub createActiveSheetCode()
    Dim sh As Worksheet       'ワークシートオブジェクト
    
    Set sh = ThisWorkbook.ActiveSheet
    Call createCode(sh)
    
    Set sh = Nothing
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】コード自動生成
'【処理概要】指定されたワークシートからVBAのコードを自動生成する。このワークブックと同階層に
'            テキストファイルとして出力する。
'【引    数】[I]ByVal sh As Worksheet
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Sub createCode(ByVal sh As Worksheet)
    Dim arr As Variant        '作業領域配列
    Dim index As Long         'カウンタ
    Dim endRowIndex As Long   '最終行
    Dim filePath As String    'ファイルパス
    Dim fileNumber As Integer 'ファイルナンバー
    Dim buf As String         '作成領域
    Dim camel As String       'キャメル
    
    '末尾行
    endRowIndex = sh.Cells(Rows.Count, eCol.LOGICAL_NAME).End(xlUp).Row
    '配列に格納
    arr = sh.Range(sh.Cells(7, eCol.NO), sh.Cells(endRowIndex, eCol.NOTE))
    
    filePath = ThisWorkbook.Path & "\" & sh.Range("D4").Value & ".cls"
    
    fileNumber = FreeFile
    Open filePath For Output As #fileNumber
    
    'プロパティを出力
    For index = 1 To UBound(arr)
        Print #fileNumber, "Private " & arr(index, eCol.PHYSICAL_NAME) & " As " & arr(index, eCol.TYPE_NAME) _
            & " '" & arr(index, eCol.LOGICAL_NAME)
    Next index
    
    '空行
    Print #fileNumber, ""
    
    'アクセサを出力
    For index = 1 To UBound(arr)
        If arr(index, eCol.OBJ_FLG) = "〇" Then
            buf = OBJ_GETTER_SETTER_TMP
        Else
            buf = GETTER_LETTER_TMP
        End If
        
        '論理名
        buf = Replace(buf, "{0}", arr(index, eCol.LOGICAL_NAME))
        'メソッド名(キャメルに変換)
        camel = Replace(WorksheetFunction.Proper(arr(index, eCol.PHYSICAL_NAME)), "_", "")
        buf = Replace(buf, "{1}", camel)
        '型
        buf = Replace(buf, "{2}", arr(index, eCol.TYPE_NAME))
        '物理名
        buf = Replace(buf, "{3}", arr(index, eCol.PHYSICAL_NAME))
        
        Print #1, buf
    Next index
    
    Close #fileNumber
End Sub

マクロ入りブックのダウンロードが気にならない方はどうぞ。
別に変なものは仕込んでません。

Bean設計書

1 ファイル 31.45 KB

Bean設計書.xlsm