Excelでアドベントお手紙カレンダーを作ろう-その6-
はじめに
今回は前回に引き続き、
クリスマスっぽいものを記事を通して作ってみよう!
という企画の続きです。
前回は、
新たに発生した問題の解消や、
各オーナメントにお手紙を持たせる
ところまで進めることができました。
今回は、
アドベントお手紙カレンダーを当日まで開けない仕組み
を追加します。
そして、
最終的なアドベントお手紙カレンダーのお披露目
を実施いたします。
やりたいこと
アドベントカレンダーなので、
当然ですが「未来の日付」は開けないようにしたいです。
例えば、
・12月1日は「01」だけ開ける
・12月2日になったら「01」「02」が開ける
・それ以降の日付は「まだ開けません」と表示する
という挙動を目指します。
日付判定の考え方
Excelには、今日の日付を取得できる便利な関数があります。
VBAでは、
Date
を使うことで「今日の日付」を取得できます。
今回はこの日付から、
「今日は12月の何日か」
を取り出して判定に使います。
処理の流れ
今回追加する処理の流れは以下です。
① クリックされたオーナメントの日付を取得
② 今日の日付を取得
③ オーナメントの日付 ≤ 今日の日付 かを判定
④ OKならお手紙を開く
⑤ NGなら「まだ開けません」と表示する
VBAコードの追記
前回で、アドベントお手紙カレンダーとしての機能は実装できました。
そのため、今回は前回のコードに日付判定箇所を追加します。
こちらに関しても、ChatGPT先生に考えてもらいました。
追加するのは以下コードです。
Dim todayDay As Integer
todayDay = Day(Date)
If CInt(dayNumber) > todayDay Then
MsgBox "このお手紙はまだ開けません。", vbExclamation
Exit Sub
End If
また、追加する位置については特に指定がなかったため、
以下のように記載したところ、うまく動きました。
Sub Ornament_Click()
Dim groupName As String
Dim dayNumber As String
Dim message As String
' クリックされたオーナメント名を取得
groupName = Application.Caller
' ornament_05 → 05
dayNumber = Replace(groupName, "ornament_", "")
Dim todayDay As Integer
todayDay = Day(Date)
If CInt(dayNumber) > todayDay Then
MsgBox "このお手紙はまだ開けません。", vbExclamation
Exit Sub
End If
Select Case dayNumber
Case "01"
message = "12月1日のお手紙です。はじめまして!"
Case "02"
message = "12月2日のお手紙です。少しずつ寒くなってきましたね。"
Case "03"
message = "12月3日のお手紙です。今日もお疲れさまです。"
挙動を確認したところ、うまく動作しているようです。
記載場所としては、オーナメント名から dayNumber を定義したあと、
Select Case による分岐の前に追加しています。
動かしてみる
実際に動かしてみます。
・未来の日付のオーナメント → 注意メッセージ

このように、ちゃんと「アドベントカレンダー」らしい挙動になりました。
※ちなみに挙動確認の際は、オーナメントの上に配置した検知用の図形に振り分けている名前の数字箇所を未来の数字に変えることで、簡単に確認することができます。
完成!
これで、
・クリックできる
・日付ごとにお手紙が違う
・当日まで開けない
という、
それっぽいアドベントお手紙カレンダー
が完成しました!
おわりに
最初は、「Excelで何か作れたら楽しそう」くらいの気持ちで始めましたが、
気づけば、
・図形
・VBA
・設計の考え方
まで触ることになりました。
技術力はまだまだですが、AIというツールを使うことで、
自分の想像したものを実際に形にすることができました。
また、AIが出力するコードも一発で動くとは限らないため、
「なぜ動かないのか?」を自分なりに考える場面も多くありました。
その過程を通して、技術をより身近に感じながら触れることができたと思います。
もし、
「Excelで何か作ってみたい」と思っている方や、
「誰かに楽しんでもらえるものを作ってみたい」と考えている方がいたら、
このシリーズが、少しでも「作ってみたい」と思うきっかけになれば嬉しいです。

