ＢＲＥＷの画面部分のプログラムをＥｘｃｅｌの仕様書から自動生成するという、シリーズ仕様書からプログラムソースを生成する方法の続きです。
今、仕様書にメニュー部分を追加しています。
以前、ここに、以下の手順で考えると良いとかきました
メニュー項目に限らず、このような、雛形があって、そこから、自動生成する場合については、以下のような手順で考えると、考えやすいと思います。
１．仕様を決める
２．仕様を満たすためには、どういう出力をすればいいか－出力ソースサンプルを作る
３．サンプルをもとに雛形を作る
４．雛形から、出力にもってくるプログラム部分を作成する。
前回、雛形を作ったので、今回は、「プログラム部分を作成する」です。
■プログラムの仕様について
ということで、プログラムを書きます。
メニューを追加する場合、以下のように動くことになります
１．作業用ワークシートを作成する
２．もともとのワークシートを、作業用ワークシートに書き写す
３．作業一覧を作成する
４．作業一覧をもとに、雛形と、２で作った仕様書からプログラムを生成する
５．作業が終わったら、２のワークシートを削除する。
今回、４はすでにある（標準化されている）ので、１～３と５を作ることになります。
１～３に関しては、initAppData()、５はfreeAppData()でつくります。
今回、２の作業をひとつの関数にしました。それが、makeSagyoSheetです。
これらの関数をＶＢＡで作成します。
なお、作業用ワークシートの名前ですが、ワークシートの名前の頭に@をつけることにしました。つまり、第一画面シートの作業用シートは@第一画面です。
■ソース
ということで、Ｅｘｃｅｌの仕様書で、「ドキュメント作成」ボタンが押されてから動くマクロプログラムのうち、今回修正／追加される、initAppData、freeAppData、makeSagyoSheetのソースは、以下のとおりです。
'//*************************************************//
'// //
'// 個別処理 //
'// //
'//*************************************************//
Public Const gamen_teigi_str_gyo As Integer = 5 '画面定義の開始行
'//=========================//
'// 前処理 //
'//=========================//
Sub initAppData()
Dim gyo As Integer
Dim pathdir As String
Dim i As Integer
Dim j As Integer
Dim sagyoShname As String ' 作業用シート名
Dim sagyoSh As Worksheet ' 作業用シート名
Dim shname() As String
'// 作業一覧シートクリア
gyo = Sheets("作業一覧").Range("A65536").End(xlUp).Row
If (gyo ＞= 5) Then
Sheets("作業一覧").Range("A5:C" & CStr(gyo)).Clear
End If
'// 値の初期設定
pathdir = ActiveWorkbook.Path '// 読み込み書き出しパス
gyo = 5 '// 書き出し開始行
'// 主処理：作業一覧の書き出し
j = 0
For i = 1 To Sheets.Count
'//=========================//
'// 画面一覧の場合 //
'//=========================//
If (Sheets(i).Range("B1") = "画面一覧") Then
'// アプリ用ソース書き出し
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥app_c.txt"
Sheets("作業一覧").Cells(gyo, 2) = Sheets(i).Name
Sheets("作業一覧").Cells(gyo, 3) = pathdir & "￥" & Sheets(i).Range("B2") & ".c"
gyo = gyo + 1
'// アプリ用ヘッダー書き出し
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥app_h.txt"
Sheets("作業一覧").Cells(gyo, 2) = Sheets(i).Name
Sheets("作業一覧").Cells(gyo, 3) = pathdir & "￥" & Sheets(i).Range("B2") & ".h"
gyo = gyo + 1
'// バージョン用書き出し
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥version_h.txt"
Sheets("作業一覧").Cells(gyo, 2) = Sheets(i).Name
Sheets("作業一覧").Cells(gyo, 3) = pathdir & "￥version.h"
gyo = gyo + 1
End If
'//=========================//
'// 各画面定義の場合 //
'//=========================//
If (Sheets(i).Range("B1") = "画面定義") Then
'// 新規画面用にシート名保存
ReDim Preserve shname(j + 1)
shname(j) = Sheets(i).Name
sagyoShname = "@" & Sheets(i).Name
j = j + 1
'// 画面用ソース書き出し
If (Sheets(i).Cells(gamen_teigi_str_gyo, 1) = "") Then
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥gamen_c.txt"
Else
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥gamen_b_c.txt"
End If
Sheets("作業一覧").Cells(gyo, 2) = sagyoShname
Sheets("作業一覧").Cells(gyo, 3) = pathdir & "￥" & Sheets(i).Range("D2") & ".c"
gyo = gyo + 1
'// 画面用ヘッダ書き出し
If (Sheets(i).Cells(gamen_teigi_str_gyo, 1) = "") Then
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥gamen_h.txt"
Else
Sheets("作業一覧").Cells(gyo, 1) = pathdir & "￥gamen_b_h.txt"
End If
Sheets("作業一覧").Cells(gyo, 2) = sagyoShname
Sheets("作業一覧").Cells(gyo, 3) = pathdir & "￥" & Sheets(i).Range("D2") & ".h"
gyo = gyo + 1
End If
Next
'// 主処理２：作業用画面定義の作成
For i = 0 To j - 1
Set sagyoSh = Sheets.Add()
sagyoShname = "@" & shname(i)
sagyoSh.Name = sagyoShname
Call makeSagyoSheet(sagyoShname, shname(i))
Set sagyoSh = Nothing
Next
End Sub
'//=========================//
'// 後処理 //
'//=========================//
Sub freeAppData()
Dim sagyoShname As String ' 作業用シート名
Dim sagyoSh As Worksheet ' 作業用シート
Dim shname() As String
Dim i As Integer
Dim j As Integer
'// 主処理1：作業用画面定義の取得
j = 0
For i = 1 To Sheets.Count
If (Left(Sheets(i).Name, 1) = "@") Then
'// 新規画面用にシート名保存
ReDim Preserve shname(j + 1)
shname(j) = Sheets(i).Name
j = j + 1
End If
Next
'// 主処理２：作業用画面定義の削除
Application.DisplayAlerts = False
For i = 0 To j - 1
Sheets(shname(i)).Delete
Next
Application.DisplayAlerts = True
End Sub
'//=========================//
'// 作業用シート書き出し //
'//=========================//
Sub makeSagyoSheet(shname As String, motoname As String)
Dim sakiSheet As Worksheet
Dim motoSheet As Worksheet
Dim lastGyo As Integer
Dim i As Integer
Dim j As Integer
Dim sts As Integer
Dim strMenuGyo As Integer
'// 元、先シートと最後の行を求める
Set sakiSheet = Sheets(shname)
Set motoSheet = Sheets(motoname)
lastGyo = motoSheet.Range("A65536").End(xlUp).Row
sts = 0 ' データまで
For i = 1 To lastGyo
Select Case sts
Case 0: ' データまで
If (motoSheet.Cells(i, 1) = "メニュー一覧") Then ' メニュー開始
sts = 1 ' メニュー
strMenuGyo = i
For j = 1 To 4
sakiSheet.Cells(i - strMenuGyo + 3, j + 14) = motoSheet.Cells(i, j)
Next
Else
For j = 1 To 14
sakiSheet.Cells(i, j) = motoSheet.Cells(i, j)
Next
End If
Case 1: ' メニューまで
For j = 1 To 4
sakiSheet.Cells(i - strMenuGyo + 3, j + 14) = motoSheet.Cells(i, j)
Next
End Select
Next
'//あとしまつ
Set sakiSheet = Nothing
Set motoSheet = Nothing
End Sub
|
（上記＜ ＞ ￥ は本当は半角です）
以上です。
次回のこのシリーズは、イベントの追加の話になります。
アクセス
トータル
ランキング
