1. Home » 
2. Excel VBA入門：目次 » 
3. 月間カレンダーを作成する

月間カレンダーを作成する: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

スポンサードリンク

PageViewCounter
　
　Since2006/2/27