エクセルVBAで献立自動化、栄養士さんお助けツール、テクニック集,献立自動化第二回目

献立自動化システム　第二回
ダウンロード

献立自動化システム　第二回

第一回目レビュー

■第一回目では献立表の枠組みを作成しています。

■献立表にレシピデータを取り込む方法を考えました。

下のカードから振り返ってください

エクセルVBAで献立自動化、栄養士さんお助けツール、献立作成の自動化第一回

シチュエーション ■今回から献立作成にまつわる帳票作成事務を自動化して効率化する処理について考えてみます。献立を作成するのに先立って必要なのは料理レシピです。例えば週間献立を立てるには主菜１品、汁物、副菜小鉢類、漬物類　×　３食　...

レシピデータ収集の実際

１、献立表の赤枠内のセルをダブルクリックします

①If Target.Row >= 6 And Target.Row <= 27 And Target.Column >= 4 And Target.Column <= 10 Then

■①ダブルクリックしたセルの行が６以上でかつ２７以内、ダブルクリックしたセルの列が４以上でかつ１０以内であるとき、とよみます。

If Not (Target.Row = 11 Or Target.Row = 19 Or Target.Row = 21) Then

上記の①場合であってもそのセルの行が１１，１９，２１のときは計算項目なので除外してフォームを開きます。

UserForm1.Show

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'食事カテゴリーの選択様態でフォームを開く
If Target.Row >= 6 And Target.Row <= 27 And Target.Column >= 4 And Target.Column <= 10 Then
    If Not (Target.Row = 11 Or Target.Row = 19 Or Target.Row = 21) Then
        UserForm1.Show
    End If
End If
'ダブルクリックではセルが編集状態になるのでそれをキャンセルする
Cancel = True
End Sub

２，フォームを開いて、作成済みのレシピの一覧を表示する

今回はここまでにします。以下の３，４は次回以降に考えていきます。

３，レシピの一覧から適宜のレシピを選択（チェックを入れる）すると、そのレシピ名が１のセルに転記されると同時に献立表の印刷されない領域に、そのレシピ番号を記録する（レシピ食材の栄養価を含む詳細情報を取り出す手がかりになる）

４レシピの詳細情報でコスト計算もできるようにしたいが、そこはまたの機会にします。今回はこのくらいで次回からは具体的なプログラムに取り組みます。

プログラム

■リストビューの初期設定など

Private Sub UserForm_Initialize()
'リストビューの初期設定
 With ListView1
      .View = lvwReport           '一覧表示
      .FullRowSelect = True       '選択を行全体に変更
      .AllowColumnReorder = True  '列幅の変更を許可
      .Gridlines = True           'グリッド線の追加
      .CheckBoxes = True          'チェックボックス許可
      '-----列名セット---------------------------------------
      .ColumnHeaders.Add , "ID", "レシピ番号", 50
      .ColumnHeaders.Add , "resipimei", "レシピ名", 100
      .ColumnHeaders.Add , "subuname", "サブName", 130      '1
      .ColumnHeaders.Add , "syokusyu", "食種", 50     '3
      .ColumnHeaders.Add , "ryouribunnrui", "料理分類", 50     '4
      .ColumnHeaders.Add , "kakou", "加工", 50         '6
      .ColumnHeaders.Add , "juuki", "什器", 30           '7
      .ColumnHeaders.Add , "kakaku", "販売価格", 30     '9
      .ColumnHeaders.Add , "tejun", "調理手順", 80             '10
      .ColumnHeaders.Add , "image", "Imageアドレス", 80        '10
  End With
End Sub

■フォームが開いたときリストビューにレシピデータを取り込む処理

Private Sub UserForm_Activate()
'レシピ管理項目CSVを読込む　フォルダrecipedata　　ファイルrecipeKanri.csv
Dim kanriCSV As Variant
Dim r As Long, i As Long

kanriCSV = det_in("\recipedata\recipeKanri.csv")
With ListView1
    .ListItems.Clear
    For r = 1 To UBound(kanriCSV, 1) - 3
        .ListItems.Add Text:=kanriCSV(r + 1, 0)
        For i = 1 To 9
            .ListItems(r).SubItems(i) = kanriCSV(r + 1, i)
        Next i
    Next r
End With
End Sub

■レシピデータを取り込んで二次元配列にする処理

Function det_in(fail As String) As Variant
'faileのＣＳＶファイルを二次元配列に格納して返す

    Dim fso As Object                 'FileSystemObject
    Dim ffile As Object               'File
    Dim csvName As String
    Dim myData As Variant
    
    Dim myDataLine As Variant
    Dim Ccnt As Long, Rcnt As Long
    Dim i As Long, j As Long
    
    csvName = ActiveWorkbook.Path & fail
    
    'オブジェクト作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ffile = fso.OpenTextFile(csvName, 1)

    ' 配列の上限設定
    myDataLine = Split(ffile.readline, ",")
    Ccnt = UBound(myDataLine)          '列数
    
    ffile.readall
    Rcnt = ffile.Line                       '行数
    ffile.Close
    ReDim myData(Rcnt, Ccnt)
    
    ' ２次元配列に格納
    Set ffile = fso.OpenTextFile(csvName, 1)
    j = 0
    Do Until ffile.AtEndOfStream
        myDataLine = Split(ffile.readline, ",")
        For i = 0 To Ccnt
            myData(j, i) = Replace(myDataLine(i), """", "")
        Next
        j = j + 1
    Loop
    ffile.Close
    
    det_in = myData
    
    
End Function