テクニック集第5.5回、ちょっと一休み。エクセルVBAで献立自動化、栄養士さんお助けツール

前回までのレビュー
プログラム
ダウンロード

前回までのレビュー

第五回では週間献立表の月曜日1日分の献立にレシピを割り当て登録し転送ボタンを押すことで、献立作業指示書のシートにレシピの食材情報を自動転記する。というところまで処理の説明をしました。

一日分の処理が完成したところから続けて、火曜日、水曜日・・・日曜日と順次一週間を連続で処理を拡張する内容を第六回目として記事にする予定でした。

が、週間献立表に他の曜日のレシピを設定する段階で、まだサンプルレシピ数が全然足りない状態だったので、第六回の記事の途中で一旦一休みしてレシピの不足分を作成補充することにしました。

そのレシピ作成作業中に、食材アイテムを新規に追加する必要があったのですが、レシピ作成システムにその機能が備わっていないことに気付いたため、記事の作成を一時中断して、食材アイテム作成機能をプログラム追加しました。

■　下図がその初期画面です。レシピの最初の表示画面に新しく新規追加ボタンを設置し、クリックで表示したアイテム追加画面です。

■機能

■　Item新規作成フォームでは上段に３個のボタンを設定しています。

１つ目は既存の食材アイテムの栄養成分データを使って名前を変えて新しい食材として登録する機能です。例えば既存の「人参」の成分データを使って、「人参　30×30」という食材を登録できます。

2つ目は、全く新しい食材を登録する機能で、一般的に市販されている食品の登録が必要な場合、その食品の栄養成分が分かれば、新規でその成分値を登録できる機能です。

例えば、下図はある菓子パンの栄養成分表示ですが、この成分値を直接入力してこの食品をそのまま登録します。

3っつ目は、組合せ食材を登録する機能です。

例えば給食では一般的な食材として「ミックスベジタブル」という食材を使用しますが、この食材は本システムで使用している８訂版食品成分表には現段階で登録されていません。

3種類の野菜カーネルコーン、人参、グリンピースをそれぞれ33％ずつ組み合わせることで１つの「ミックスベジタブル」という食材として登録できます。

プログラム

■　既存の食材アイテムCSVに食材Itemを追加登録する処理です。

■　19行目のOpenメソッドの既存データに追記するAppendモードを使用しています。

Sub tuikaTouroku(pl As Integer)
'plが　１はこぴーして登録、２は一覧データそのまま登録
'コピーして登録（CSVファイルに追加登録）
'Public mykoreEiyou As New Collection '（モジュール１に）
    Dim myPath          As String
    Dim FileNumber      As Integer
    Dim outDats(70) As Variant
    Dim i As Integer
    
    ''itemdata = det_in(ActiveWorkbook.Path & "\recipedata\item_revi8.csv")userform2で定義済み

    'このマクロが組み込まれたエクセルファイルと
    '同じフォルダにある"item_revi8.csv.csv"を出力ファイルとします。
    myPath = ActiveWorkbook.Path & "\recipedata\item_revi8.csv"

    '空いているファイル番号を取得します。
    FileNumber = FreeFile
    'ファイルを追記、Appendモードで開きます。
    Open myPath For Append As #FileNumber

    '出力用のコレクション　mykoreEiyou 一覧データ全部を配列にセットします。
    For i = 0 To 70
        outDats(i) = mykoreEiyou(i + 1)
    Next i
    
    'plが　１はこぴーして登録、それ以外は一覧データそのまま登録
    'コピーして登録の時は新しいデータ部分を上書き
    If pl = 1 Then
        outDats(1) = kopiNew.Label11.Caption 'label11 新しい食品番号
        outDats(3) = kopiNew.TextBox1.Value  'textbox1 新しい食品名
        outDats(61) = kopiNew.TextBox2.Value  'textbox2 新しい備考
        outDats(62) = kopiNew.TextBox3.Value  'textbox3 新しい別名
    End If
    '－－－－－－－－－－－－－－－－－－－－－－－－
    '配列の要素をカンマで結合して出力します。
    Print #FileNumber, Join(outDats, ",")

    '入力ファイルを閉じます。
    Close #FileNumber

End Sub