【盛り付け表】テキストボックスの自動作成

どうもタムです。

今回は、盛り付け表での自動化。このツイートの内容です。

盛り付け表
テキストボックス、日付の自動作成
明日noteにアップ予定です

最初の画像、献立一覧から
日付とテキストボックスが作成されます
あとは、場所の調整のみ

様式が違うため活用できる方が限られます😔
今後、汎用的なものが作れるようコツコツ頑張ります。 pic.twitter.com/BKyYiSDOS4

— タム🌱栄養教諭 (@shoku_iku_tam) September 5, 2020

献立表を作るときには、毎回、毎回、テキストボックスに献立名を打ち込んで、それを配置して、作成して、配置して、、、という単純作業をひと月分約５０回ほど繰り返します。これ、だいぶストレスなんですね。

さらに、正しくテキスト入力ができればいいのですが入力ミスや配置ミスがあるので、その修正や確認の時間も入れると残業確定です。

今回はテキストボックスの作成を考えてみました。

することは２つ、日付の入力と献立一覧への入力です。これで気が乗らない単純作業から解放されましたので、ぜひご覧になっていってください。

動作の説明

まず、していただくのが「日」にちの欄です。

9/1のような形式で入力してください。この日にちによって、左側の曜日や右側の年周、月週などが計算、表示されます。

※グレーに塗りつぶされている箇所には数式が入っています。

次に、献立一覧を埋めてください。

これに似た様式で、献立一覧を作成している人がいれば、リンク貼り付けを組み込んでおくだけで、５秒あれば入力作業は終わります。リンク貼り付け？？という方はすこしググってみてください。日々の作業が楽になるかもしれませんよ。

さあ、献立一覧への入力が終わればテキストと書かれたボタンを押すと、テキストボックスが作成されます。あとは、配置を調整するだけです。

注意点

シート内に列や行を挿入すると、正しく機能しなくなります。ご注意ください。また、テキストボックスが作成される位置はあらかじめ決まっています。行の高さや列の幅に連動して作成することができればいいのですが、その技術は持ち合わせておりません…

残念ながら、セルの幅を変えると、上の図のようにずれがでてしまいます。

今回、ごはんやお椀などの図形は、著作権の所在が不明のため削除しております。

皆さんの業務効率化、エクセルvbaの勉強になれば幸いです！一度、仕事で使用される前に試しに使ってみてください。

↓↓↓ダウンロードはこちらから↓↓↓

盛り付け表.xlsm

31793 Bytes

ファイルダウンロードについて

ダウンロード

合わせてこちらもどうぞ
【業務効率化】「一括置換」のExcelファイルhttps://note.com/tamkun/n/n9d34a83bc264

※マクロのダウンロードは危険なこともあるので注意してください。ファイルに入っているプログラムは下に乗せています。

プログラム

日付について

Sub 日付2()
Dim i, y, t As Long
For i = 3 To 33
　　If Sheets(1).Cells(i, 13) = "" Then
Else
　　y = Sheets(1).Cells(i, 10).Value
 　　t = Sheets(1).Cells(i, 13).Value
　　Sheets(2).Cells(2 * y, t) = Sheets(1).Cells(i, 2).Value
End If
Next i
End Sub

テキストについて

Sub テキスト()
Dim i, j, k, o, t, x, y, z, a As Long
Dim txt As Shape
On Error Resume Next
For j = 3 To 33 ' 行3～33

If Sheets(1).Cells(j, 3) = "" Then
Else
　o = Sheets(1).Cells(j, 10).Value '月週
　t = Sheets(1).Cells(j, 13).Value '週番（曜日）
'主食の位置
　x = 233 * (t + 2) - 672 '横軸の作成位置
　y = 170 * o + 120 '縦軸の作成位置
　Set txt = Worksheets(2).Shapes.AddTextbox(msoTextOrientationHorizontal, x, y, 100, 20)
　txt.TextFrame.Characters.Text = Sheets(1).Cells(j, 3).Value 'この値を入れる
　txt.TextFrame.AutoSize = True
　txt.TextFrame2.TextRange.Font.Size = 9
　txt.TextFrame2.TextRange.Font.Bold = msoTrue
End If
'副菜の位置
For k = 5 To 8
If Sheets(1).Cells(j, k) = "" Then
Else
　z = 30 * k - 250 '縦軸、次のテキストボックスとの間隔
　a = 120 '横軸、xとの間隔
　Set txt = Worksheets(2).Shapes.AddTextbox(msoTextOrientationHorizontal, x + a, y + z, 100, 20)
　txt.TextFrame.Characters.Text = Sheets(1).Cells(j, k).Value
　txt.TextFrame.AutoSize = True
　txt.TextFrame2.TextRange.Font.Size = 9
　txt.TextFrame2.TextRange.Font.Bold = msoTrue
End If
Next k
Next j
End Sub

中央揃え（テキストボックスの書式を中央揃えにします。）

Sub 中央()
Dim shp As Shape
On Error Resume Next
For Each shp In ActiveSheet.Shapes '※すべての図が対象
　With shp.TextFrame2
　　　.VerticalAnchor = msoAnchorMiddle
　　　.HorizontalAnchor = msoAnchorCenter
　 End With
Next shp
End Sub