月間カレンダーを作成する:Excel VBA入門

スポンサードリンク

月間カレンダーを作成する　　　topへ

年月を指定して1か月分のカレンダーを作成してみます。
祝日(指定休日)はL2以降に書き出しておきます。書き出す範囲は Range("L2:L212") に設定してあります。
- このリストには祝日に加えて指定休日が入っていますので、祝日だけでよい場合は省略して入力します。
- チェックに使用するのはL列の値ですので、M,N列は無くても構いませんが、間違いがあった時は見つけやすいので書いておきます。
- 祝日の書き出す範囲はRange("L2:L212") と数年分を入力してもよいように作成しています。
  エクセル関数の技：日付に関する技/祝日一覧表　に2011～2022年の祝日の表を作成していますので利用してください。なお、祝日などの変更を修正できていないかもしれませんので、使用時には間違いがないかのチェックをお願いします。

コードの作成例です。

Sub calendar_month2()
　　Dim myDate As String
　　Dim Nen As Integer, Tuki As Integer
　　Dim i As Integer, j As Long, k As Integer
　　Dim cn As Long
　　Dim myTitleD, myTitle(1 To 1, 1 To 7)
　　Dim myTable(1 To 6, 1 To 7)
　　Dim c As Range
　　　　'作成する年月を入力します
　　　　myDate = Application.InputBox(Title:="年月の指定", _
　　　　　　　　　　　　　　Prompt:="年月を 2011/5 の形式で入力してください", _
　　　　　　　　　　　　　　Default:="2011/5", Type:=2)
　　　　　　'キャンセルボタンを押したとき、日付でないデータの時は終了する
　　　　　　If myDate = "False" Or Not IsDate(myDate) Then
　　　　　　　　　MsgBox "終了しました"
　　　　　　　　　Exit Sub
　　　　　　End If
　　　　Nen = Year(myDate)
　　　　Tuki = Month(myDate)
　　　　'曜日を配列にセットします
　　　　myTitleD = Array("日", "月", "火", "水", "木", "金", "土")
　　　　For k = 0 To 6
　　　　　　myTitle(1, k + 1) = myTitleD(k)
　　　　Next k
　　　　'指定月の日付を配列にセットします
　　　　cn = 1
　　　　For j = DateSerial(Nen, Tuki, 1) To DateSerial(Nen, Tuki + 1, 0)
　　　　　　If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 1
　　　　　　myTable(cn, Weekday(j)) = Format(j, "yyyy/m/d")
　　　　Next j
　　　　'シートに書き出します
　　　　Application.ScreenUpdating = False
　　　　Range("A:H").Clear
　　　　Range("A1").Value = DateSerial(Nen, Tuki, 1)
　　　　Range("B2").Resize(1, 7).Value = myTitle
　　　　Range("B3").Resize(6, 7).Value = myTable
　　　　'書式を設定します
　　　　Range("A1").NumberFormatLocal = "yyyy""年""m""月"""
　　　　Range("B2").Resize(7, 7).HorizontalAlignment = xlCenter
　　　　Range("B3").Resize(6, 7).NumberFormatLocal = "d"
　　　　'日曜日は赤色,土曜日は青色にします
　　　　Range("B2").Resize(7, 1).Font.Color = RGB(255, 0, 0)
　　　　Range("H2").Resize(7, 1).Font.Color = RGB(0, 0, 255)
　　　　'祝日(指定休日)のチェックし、赤色の太文字にします
　　　　For Each c In Range("B3").Resize(6, 7)
　　　　　　If Application.CountIf(Range("L2:L212"), c.Value) > 0 Then
　　　　　　　　c.Font.Color = RGB(255, 0, 0)
　　　　　　　　c.Font.Bold = True
　　　　　　End If
　　　　Next c
　　　　Application.ScreenUpdating = True
End Sub

【例】データは配列に入れてシートへ書き出すようにしています。コードを修正しました(2011/2/26)
1904年日付システムでは不具合がありましたのでコードを修正しました。(2011/5/12)
- [XL] 1900 年から計算する日付システムと 1904 年から計算する日付システム
  http://support.microsoft.com/kb/180162/ja
日曜日は赤色,土曜日は青色にするコードを一部修正しました。2017年4月のカレンダーを作成したところ、着色する行数が1つ足りないことがわかりました。
(2017/3/11 記)
Range("B2").Resize(6, 1).Font.Color = RGB(255, 0, 0)→Range("B2").Resize(7, 1).Font.Color = RGB(255, 0, 0)
Range("H2").Resize(6, 1).Font.Color = RGB(0, 0, 255)→Range("H2").Resize(7, 1).Font.Color = RGB(0, 0, 255)
としました。
インプットボックスのキャンセルボタンを押すとエラーとなっているとの質問がありましたので、この辺の動作を修正しました。
キャンセルボタンを押すとメッセージボックスでVBAを終了しま下と表示するように変更しました。
また、入力値を日付データと解釈できない場合も同様に終了するように変更しました。
(2017/3/11 記)

日付を1行おきにして、メモ欄を設ける例です。(2019/2/1 追記しました。)

下図のようにメモが書き込めるように日付を1行おきにしています。

2019年5月の祝日は変則です。
休日はSheet2のA2以降に書き出しています。

上記のコードから赤色の部分を変更しています。

Sub calendar_month2_A()
　Dim myDate As String
　Dim Nen As Integer, Tuki As Integer
　Dim i As Integer, j As Long, k As Integer
　Dim cn As Long
　Dim myTitleD, myTitle(1 To 1, 1 To 7)
　Dim myTable(1 To 12, 1 To 7)
　Dim c As Range
　　'作成する年月を入力します
　　　myDate = Application.InputBox(Title:="年月の指定", _
　　　Prompt:="年月を 2011/5 の形式で入力してください", _
　　　Default:="2019/1", Type:=2)
　　'キャンセルボタンを押したとき、日付でないデータの時は終了する
　　　If myDate = "False" Or Not IsDate(myDate) Then
　　　　　MsgBox "終了しました"
　　　　　Exit Sub
　　　End If
　　　Nen = Year(myDate)
　　　Tuki = Month(myDate)
　　'曜日を配列にセットします
　　　myTitleD = Array("日", "月", "火", "水", "木", "金", "土")
　　　For k = 0 To 6
　　　　myTitle(1, k + 1) = myTitleD(k)
　　　Next k
　　'指定月の日付を配列にセットします
　　　cn = 1
　　　For j = DateSerial(Nen, Tuki, 1) To DateSerial(Nen, Tuki + 1, 0)
　　　　　If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 2
　　　　　　　myTable(cn, Weekday(j)) = Format(j, "yyyy/m/d")
　　　　　Next j
　　'シートに書き出します
　　　Application.ScreenUpdating = False
　　　Range("A:H").Clear
　　　Range("A1").Value = DateSerial(Nen, Tuki, 1)
　　　Range("B2").Resize(1, 7).Value = myTitle
　　　Range("B3").Resize(12, 7).Value = myTable
　　'書式を設定します
　　　Range("A1").NumberFormatLocal = "yyyy""年""m""月"""
　　　Range("B2").Resize(13, 7).HorizontalAlignment = xlCenter
　　　Range("B3").Resize(12, 7).NumberFormatLocal = "d"
　　　Range("B2").Resize(13, 7).Borders.LineStyle = True
　　'日曜日は赤色,土曜日は青色にします
　　　Range("B2").Resize(13, 1).Font.Color = RGB(255, 0, 0)
　　　Range("H2").Resize(13, 1).Font.Color = RGB(0, 0, 255)
　　'祝日(指定休日)のチェックし、赤色の太文字にします
　　　For Each c In Range("B3").Resize(12, 7)
　　　　　If Application.CountIf(Worksheets("Sheet2").Range("A2:A212"), c.Value) > 0 Then
　　　　　　　c.Font.Color = RGB(255, 0, 0)
　　　　　　　c.Font.Bold = True
　　　　　End If
　　　Next c
　　　Application.ScreenUpdating = True
End Sub

コードの各部分ごとの説明　　　topへ

年月の指定

【例】インプットボックスには　年/月　の形式で入力してもらいます。初期値として「2011/5」を表示しています。
この形式以外で入力するとおかしなことになったりしますが、エラー処理はしていません。
文字列として入力するのですが、Excelが日付データへ変換するので年と月をYear関数とMonth関数で取り出して変数Nen、Tukiに入れます。

Dim myDate As String
Dim Nen As Integer, Tuki As Integer

　　'作成する年月を入力します
　　myDate = Application.InputBox(Title:="年月の指定", _
　　　　　　　　　　　　Prompt:="年月を 2011/5 の形式で入力してください", _
　　　　　　　　　　　　Default:="2011/5", Type:=2)
　　Nen = Year(myDate)
　　Tuki = Month(myDate)

日付をセットする

コードの例

最初の日付DateSerial(Nen, Tuki, 1)～最後の日付DateSerial(Nen, Tuki + 1, 0)をFor～Nextでループして配列myTableへ書き込みます。
1日から月の末日までをループして配列に入れるので、末日はDateSerial(Nen, Tuki + 1, 0)とすることができます。
次の月の0日=前月の末日　となるためです。
2011/1/1のシリアル値は40544ですので、Dim j As Long　とjはLongとします。(1900年日付システムのシリアル値です)

　Dim j As Long
　Dim cn As Long
　Dim myTable(1 To 6, 1 To 7)
　　　　'月の日付を配列にセットします
　　　　cn = 1
　　　　For j = DateSerial(Nen, Tuki, 1) To DateSerial(Nen, Tuki + 1, 0)
　　　　　　If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 1
　　　　　　myTable(cn, Weekday(j)) = Format(j, "yyyy/m/d")
　　　　Next j

日にちだけ(1,2,3・・・)をシートに書き出してもよいのですが、ここでは日付データ（2011/5/1,2011/5/2・・・・)としてシートに書き出したいと思います。
- ひと月は1日が土曜日などのとき最大6行になりますので、配列はmyTable(1 To 6, 1 To 7)としています。
- 日曜日で週替わりとするため、カウンターcnを1から始めて、日曜日が出てきたらカウントアップします。
  ただし、1日が日曜のときは1のままでよいので　If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 1　として除きます。
- 配列myTableは下図のイメージになります。該当するところに日付を入れていきます。
  myTable(cn,Weekday(j))として、Weekday関数の返り値を利用しています。
- 下図は配列の要素と書き出すセルとの位置を示しています。

曜日や日付をシートに書き出します。

Application.ScreenUpdating = False　で画面の描画を止めています。最後には元に戻しています。
Range("B2").Resize(1, 7).Value = myTitle　　←B2：H2セルに曜日を格納した配列myTitleの値を書き出してます。
Range("B3").Resize(6, 7).Value = myTable　←B3：H8セルに配列myTableへ格納した日付を書き出しています。
A1セルは○○○○年○月という表示形式「"yyyy""年""m""月"""」にし、B1:H6は中央揃え、日付部分のB3:H7は表示形式を　"d"　としています。

　　　　'シートに書き出します
　　　　Application.ScreenUpdating = False
　　　　Range("A:H").Clear
　　　　Range("A1").Value = DateSerial(Nen, Tuki, 1)
　　　　Range("B2").Resize(1, 7).Value = myTitle
　　　　Range("B3").Resize(6, 7).Value = myTable
　　　　'書式を設定します
　　　　Range("A1").NumberFormatLocal = "yyyy""年""m""月"""
　　　　Range("B2").Resize(7, 7).HorizontalAlignment = xlCenter
　　　　Range("B3").Resize(6, 7).NumberFormatLocal = "d"
　　　　'日曜日は赤色,土曜日は青色にします
　　　　Range("B2").Resize(7, 1).Font.Color = RGB(255, 0, 0)
　　　　Range("H2").Resize(7, 1).Font.Color = RGB(0, 0, 255)
・・・・・
・・・・・
　　　　Application.ScreenUpdating = True

祝日(指定休日)のチェックし、赤色の太文字にします

【例】祝日(指定休日)はL2以降に入力していますので、ワークシート関数のCountifでリストに有るか/ないかを判定しています。
リストに有ればフォントの色を赤色にし太字にしています。

この例では祝日と指定休日のリストは複数年分がL2:L212に入力してあります。
実情に合わせて修正する必要があります。

　　'祝日(指定休日)のチェックし、赤色の太文字にします
　　　　　　If Application.CountIf(Range("L2:L212"), c.Value) > 0 Then
　　　　　　　　c.Font.Color = RGB(255, 0, 0)
　　　　　　　　c.Font.Bold = True
　　　　　　End If

スポンサードリンク

よねさんのWordとExcelの小部屋｜Excel(エクセル)講座の総目次｜Excel(エクセル) VBA入門：目次｜月間カレンダーを作成する

PageViewCounter
　 Counter
　Since2006/2/27

月間カレンダーを作成する:Excel VBA入門

月間カレンダーを作成する topへ

日付を1行おきにして、メモ欄を設ける例です。(2019/2/1 追記しました。)

コードの各部分ごとの説明 topへ

月間カレンダーを作成する　　　topへ

コードの各部分ごとの説明　　　topへ