カレンダー関係　味はソコソコ？Excel Tips（しお味）

カレンダーの作成

Accessでは、カレンダーモジュールがあらかじめ実装されていて、日付の入力などはカレンダーからの選択形式で入力するような事が簡単に出来ます。 excelではAccessの様なカレンダーの取扱いをするのにvb（Visual Basic）由来のコントロール（Microsoft Date and Time Picker Control 6.0）を裏技的に流用したりしてきました。
ここではコントロールを使わない、ごくシンプルなカレンダーを紹介します。通常のカレンダーとプロジェクト管理によく用いられるカレンダーの二つの種類があります。

カレンダーの処理の仕方には様々ありますが、ここでは今回のサンプルのカレンダーの処理を説明します。
●カレンダーの処理の流れ（一般カレンダー）
ここでのサンプルのカレンダーの処理の流れ

1）その月の日数を取得
2）1日目の曜日を取得
3）あらかじめ用意したカレンダーの枠（7列ｘ6行）に、1日の曜日に従って1日から順次その月の日数までの数字を流し込む。
4）休日表から、休日のデータと照合してその月に該当する休日があれば、表示する。

●カレンダーの処理の流れ（簡易ガントチャート用カレンダー）

1）その月の日数を取得
2）所定の枠に、日数分だけ日付の数字を表示
3）個々の日付の曜日を取得。土曜、日曜の背景に着色する。
4）休日表から、休日のデータと照合してその月に該当する休日があれば、表示する。

一般的なカレンダー

設定画面	休日設定画面

一般的なカレンダーの例です。
年度、月度を選択すればその月のカレンダーが表示されます。
別途、休日情報をあらかじめ設定すれば、休日も表示されます。

一般的なカレンダー（メイン表示部：標準モジュール）

  Sub caren()    '■■■■■カレンダー表示（一般）■■■■■

  Dim cdt(50) As String   'カレンダー内容数字収容

  Dim cv As Integer       'カレンダー内横方向カウンタ
  Dim vv As Integer       'カレンダー内縦方向カウンタ
  Dim kd As Integer       '月日数収容
  Dim st As Integer       'カレンダー数字収容
  Dim ct As Integer       'カレンダーループカウンタ
  Dim nm As Integer       'カレンダー数字収容用ループカウンタ
  Dim hd(42) As Variant   '休日データの収容
  Dim hdc(42) As String   '休日データの収容
  Dim chd As Integer      '休日数収容
  Dim cchd As Integer     '月内休日数用カウンター


  'カレンダーの基本描写----------------------------------------------------------------------------------
  Worksheets("main").Select

  Range(Cells(16, 2), Cells(21, 8)).ClearContents                        'カレンダー初期化　カレンダー数字
  Range(Cells(16, 2), Cells(21, 8)).Interior.ColorIndex = 0              'カレンダー初期化　セルの着色
  Range(Cells(14, 2), Cells(14, 3)).ClearContents                        'カレンダー初期化　年月表示
  Range(Cells(23, 2), Cells(29, 2)).ClearContents                        'カレンダー初期化　休日説明


  Range(Cells(16, 2), Cells(21, 2)).Interior.Color = RGB(253, 219, 230)  '日曜日背景色
  Range(Cells(16, 8), Cells(21, 8)).Interior.Color = RGB(221, 235, 247)  '土曜日背景色


  '-月の基本データ算出＆表示-----------------------------------------------------------------------------

  Cells(5, 5) = Cells(5, 2) & "年" & Cells(6, 2) & "月" & "1日"                          '月初表示

  'Cells(5, 9) = Weekday(Cells(5, 2) & "年" & Cells(6, 2) & "月" & "1日")                 '月初日の曜日

  Cells(8, 6) = Format(DateSerial(Year(Cells(5, 5)), Month(Cells(5, 5)) + 1, 0), "d")    '月の日数

  Cells(6, 5) = Cells(5, 2) & "年" & Cells(6, 2) & "月" & Cells(8, 6) & "日"             '月末表示

  Cells(14, 2) = Cells(5, 2) & "年" & Cells(6, 2) & "月度"                               'カレンダーの表題


  '-----------------------------------------------------------------------------------------------------

  cv = 1                                                                                 'カウンター初期値設定
  kd = Cells(8, 6)                                                                       '月日数取得
  'st = Cells(5, 9)                                 '月初の曜日取得
  st = Weekday(Cells(5, 2) & "年" & Cells(6, 2) & "月" & "1日")                          '月初の曜日取得
  chd = Worksheets("休日").Cells(1, 4)                                                   '休日の数

  '休日データ取得

  For k = 1 To chd

   hd(k) = Trim(Worksheets("休日").Cells(k + 2, 2)) '日付
   hdc(k) = Worksheets("休日").Cells(k + 2, 3)     '説明

  Next


  '-------------------------------------------------------------------------------


  '表示用配列に1日目の曜日のバイアスをかけて数字を収容============================

  For s = st To st + kd - 1

    nm = nm + 1

    cdt(s) = nm

  Next


  For k = 1 To 42  'カレンダーの枠に全ての表示用の内容を表示させる================

      ct = ct + 1
      cv = cv + 1

      Cells(16 + vv, cv) = cdt(k)  'カレンダー枠に数字を表示

      For s = 1 To chd             '休日データとの照合

          If cdt(k) = Day(hd(s)) And Year(hd(s)) = Worksheets("main").Cells(5, 2) And Month(hd(s)) = Worksheets("main").Cells(6, 2) Then

              Worksheets("main").Cells(16 + vv, cv).Interior.Color = RGB(141, 247, 181)  '休日の着色

              cchd = cchd + 1

              Worksheets("main").Cells(22 + cchd, 2) = hdc(s)                            '休日の説明表示


          End If

      Next


          '始めの行の改行操作-----------------------------
          If cv = 8 And vv = 0 Then

              vv = vv + 1: cv = 1

              Else

          End If


          '始めの行以降の改行操作-------------------------
          If ct = 14 Or ct = 21 Or ct = 28 Or ct = 35 Then

              vv = vv + 1: cv = 1

              Else


          End If


  Next    '=======================================================================

  Cells(10, 6) = WorksheetFunction.CountA(Range("h16:h21"))  '土曜日数
  Cells(11, 6) = WorksheetFunction.CountA(Range("b16:b21"))  '日曜日数
  Cells(12, 6) = cchd                                        '休日日数


  End Sub

一般的なカレンダー（年度、月度の変化検知：シートモジュール）

  Private Sub Worksheet_Change(ByVal Target As Range)

  'mainsheetの特定範囲（年度、月度）の変化で動作＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
  '年度、月度が変わったら自動的にカレンダーを更新

  Worksheets("main").Activate

      If Intersect(Target, Worksheets("main").Range("b5:b6")) Is Nothing Then

         ' Exit Sub

      Else

          Call caren    'カレンダーの表示

      End If

  End Sub

一般的なカレンダー(ダウンロード)

簡易ガントチャート用のカレンダー

設定画面

プロジェクト管理等に良く用いられるガントチャート的なカレンダーです。年度、月度を選択すればその月の、ガントチャート的なカレンダーが表示されます。

  Sub monthupdate()

  'ガントチャート用のカレンダーの自動表示

  Dim eyear As Variant       '年度
  Dim emonth As Variant      '月度
  Dim eday As Variant        '日数

  'ActiveSheet.Protect UserInterfaceOnly:=True  'シート保護状態でのマクロ操作

  '////////////処理進行の問い合わせ//////////////////////////////////////////

   rc = MsgBox("カレンダーの更新をします。カレンダー上のデータは全てクリアーされます。" & vbCrLf & "処理を続けますか？", vbYesNo + vbQuestion)

        If rc = vbYes Then

                  ' MsgBox "処理を続けます", vbInformation

                   Else

                   MsgBox "処理を中止します", vbExclamation

                   Exit Sub

         End If

  '/////////////////////////////////////////////////////////////////////////

  eyear = Worksheets("ＧＮＴ").Cells(1, 3)     '年度の選択
  emonth = Worksheets("ＧＮＴ").Cells(1, 5)    '月度の選択
  eday = Worksheets("ＧＮＴ").Cells(3, 3) + 2  '月日数
  hdnmb = Worksheets("休日").Cells(1, 4)      '年間休日総数

  Range(Cells(2, 4), Cells(31, 36)).Interior.ColorIndex = 0    '背景色クリア
  Range(Cells(2, 4), Cells(31, 36)).Font.ColorIndex = 1
  Range(Cells(4, 4), Cells(29, 36)).ClearContents              '文字のクリア

  Worksheets("ＧＮＴ").Activate

  With ActiveSheet                                             '図形の削除

      For Each ob In .DrawingObjects

          If Not Intersect(ob.TopLeftCell, .Range(Cells(4, 4), Cells(29, 36))) Is Nothing Then

                  ob.Delete

      End If

      Next

  End With


  Cells(2, 3) = Cells(1, 3) & "/" & Cells(1, 5) & "/1"         '月初の日の設定
  Cells(2, 4).Value = Cells(2, 3).Value                        '月初の日コピー

  '土日の背景色////////////////////////////////////////////////////////////////////////////////////
  For k = 1 To eday

     Range(Cells(2, 3 + k), Cells(3, 3 + k)) = Cells(2, 3).Value + k - 1        '各日にDATEデータコピー

         If Weekday(Cells(3, 3 + k)) = 1 Or Weekday(Cells(3, 3 + k)) = 7 Then

            Range(Cells(2, 3 + k), Cells(31, 3 + k)).Interior.Color = RGB(220, 220, 220)    '土、日　背景グレー処理


                    If Weekday(Cells(3, 3 + k)) = 1 Then

                           Cells(3, 3 + k).Font.Color = RGB(252, 38, 38)                    '日曜　赤色文字
                           Cells(31, 3 + k).Font.Color = RGB(252, 38, 38)

                    Else

                           Cells(3, 3 + k).Font.Color = RGB(80, 80, 250)                    '土曜　青色文字
                           Cells(31, 3 + k).Font.Color = RGB(80, 80, 250)

                    End If

         End If

         '休日の着色*********************************************************
         For s = 1 To hdnmb

                   If Cells(2, 3 + k) = Worksheets("休日").Cells(2 + s, 2) Then

                       Range(Cells(2, 3 + k), Cells(31, 3 + k)).Interior.Color = RGB(212, 248, 212)

                   End If

         Next
         '*******************************************************************

  Next

  '//////////////////////////////////////////////////////////////////////////////////////////////////

  End Sub

カレンダー_簡易ガントチャート(ダウンロード)

カレンダー関係（まとめ）

設定画面	簡易ｶﾞﾝﾄﾁｬｰﾄ	休日設定画面

カレンダー関係（まとめ）です。
一般的なカレンダーと簡易ガントチャート用のカレンダーがあります。

カレンダー関係（まとめ）ダウンロード