Ｅｘｃｅｌ仕様書からプログラムソースを生成するマクロを、公開してみる

　昨日の
仕様書からプログラムソースを生成する方法（Ｅｘｃｅｌの仕様書編）のその２として、Ｅｘｃｅｌ仕様書から、プログラムソースを書き出す、一般的なマクロプログラムを公開してみたいと思います。
　ちなみに、これは、シリーズBREWで複数画面を開発する場合の方法論の一部です。

---

■仕様

以下の雛形ファイル(ファイル名hina1.txt)

void initFunc(IKHUser *pUser)
{
	$#$CELL B2$#$	*pMe;

	if ( pUser	==	NULL )
		return;

	pMe	= ($#$CELL B2$#$ *)pUser-＞pMe;

	switch(pUser-＞kind)
	{
$#$REP 5$#$
	case	USER_ITEM_$#$KETA A$#$:
		$#$KETA K$#$_InitAppData(pMe);
		pUser-＞val	=	pMe-＞garea;
		return;
$#$REPEND A$#$
	}
}

と、以下のようなＥｘｃｅｌファイル（シート名 画面一覧）

を入力としたとき、


以下のファイル(ファイル名out1.txt)

void initFunc(IKHUser *pUser)
{
	fukusu1	*pMe;

	if ( pUser	==	NULL )
		return;

	pMe	= (fukusu1 *)pUser-＞pMe;

	switch(pUser-＞kind)
	{

	case	USER_ITEM_GAMEN1:
		gamen1_InitAppData(pMe);
		pUser-＞val	=	pMe-＞garea;
		return;

	case	USER_ITEM_GAMEN2:
		gamen2_InitAppData(pMe);
		pUser-＞val	=	pMe-＞garea;
		return;

	case	USER_ITEM_GAMEN10:
		gamen10_InitAppData(pMe);
		pUser-＞val	=	pMe-＞garea;
		return;

	}
}

を出力するマクロを作成しなさい。

注：
・ここで示したものと、少し変えています。

・Ｅｘｃｅｌシート、実際にはＫ列は、非表示にします。なお、Ｋ列は写真のように
　=LOWER(A行数)の感じで、式が入ってます

・雛形ファイルの制御タグ（$#$で囲まれた文字列）は、以下のとおり

$#$REP 行数$#$ 繰り返し（指定行数から開始）
$#$REPEND 桁$#$ 繰り返し終了（シートの現在行の桁が空白なら繰り返し終了）
$#$CELL セル$#$　指定したセルが入る
$#$KETA 桁$#$　 繰り返し時、指定された桁が入る

---

■マクロのソースコード

マクロのソースはこちら。

Public outdata As String
Public lpstr_pos As Integer
Public lpgyo As Integer

Sub shiyoToFile()

    Call makefile("hina1.txt", "画面一覧", "out1.txt")
    MsgBox "終わりました"

End Sub

Sub makefile(infname As String, shname As String, outfname As String)

            '//=========================//
            '//     雛形を読み込む      //
            '//=========================//
    Open infname For Binary Access Read As #1
    fsize = FileLen(infname)
    Seek #1, 1
    indata = Input(fsize, #1)
    Close #1

            '//=========================//
            '//     書き出し内容作成    //
            '//=========================//
    str_pos = 1         '   開始ポイント
    outdata = ""
    tag_pos = InStr(str_pos, indata, "$#$")
    
    Do While (tag_pos > 0)
                        '直前まで書き出し
        outdata = outdata & Mid(indata, str_pos, tag_pos - str_pos)
                        
                        '制御内容終わりを探す
        end_pos = InStr(tag_pos + 3, indata, "$#$")
        If (end_pos = 0) Then
            str_pos = tag_pos + 3
            Exit Do
        End If
        
                        '制御内容コピー
        tag_data = Mid(indata, tag_pos, end_pos - tag_pos + 3)
        
                        '  制御内容ごとに処理
        str_pos = chgTagToStr(Replace(tag_data, "$#$", ""), end_pos + 3, shname)
        
        
            '   次のタグ位置を探す
        tag_pos = InStr(str_pos, indata, "$#$")
    Loop
            
            '   最後の残りを書き出し
    outdata = outdata & Mid(indata, str_pos)

            
            '//=========================//
            '//     作成データ書き出し  //
            '//=========================//
    If (Dir(outfname) = "") Then
                            '   なければ、なにもしない
    Else
        Kill outfname       '   ファイルがあったら、削除しておく
    End If
    
    Open outfname For Binary Access Write As #1
    fsize = FileLen(outfname)
    Put #1, 1, outdata
    Close #1

End Sub

Function chgTagToStr(tag As String, next_str_pos As Integer, shname As String) As Integer
    
    If (Mid(tag, 1, 6) = "REPEND") Then
        lpgyo = lpgyo + 1
        cellpos = Replace(Mid(tag, 7), " ", "") & CStr(lpgyo)
        celldata = Sheets(shname).Range(cellpos)
        If (celldata = "") Then
            chgTagToStr = next_str_pos
        Else
            chgTagToStr = lpstr_pos
        End If
        Exit Function
    End If
    
    If (Mid(tag, 1, 3) = "REP") Then
        lpstr_pos = next_str_pos
        lpgyo = CInt(Replace(Mid(tag, 4), " ", ""))
        chgTagToStr = next_str_pos
        Exit Function
    End If
    
    If (Mid(tag, 1, 4) = "CELL") Then
        cellpos = Replace(Mid(tag, 5), " ", "")
        celldata = Sheets(shname).Range(cellpos)
        outdata = outdata & celldata
        chgTagToStr = next_str_pos
        Exit Function
    End If
    
    If (Mid(tag, 1, 4) = "KETA") Then
        cellpos = Replace(Mid(tag, 5), " ", "") & CStr(lpgyo)
        celldata = Sheets(shname).Range(cellpos)
        outdata = outdata & celldata
        chgTagToStr = next_str_pos
        Exit Function
    End If

    chgTagToStr = next_str_pos

End Function

今回示したものは、条件分岐が無いので、かなり限定的です。
条件分岐があるものは、そのうち示します。
（まず、ないものを説明してからでないと、複雑になってしまうから、
　2ndとして、後日条件分岐付きを示します）

で、これを、どのように貼るか＆ボタンを押すと、動くようにする方法は、
このエントリに書ききれそうもないので、
いったんここで区切って、次回書きます。