ワンランク上のVBAを書いてみた その3

VBA カレンダープロジェクト

このプロジェクトは、Excelで動的に生成されるカレンダーを実装する方法を示しています。
セルをダブルクリックするとカレンダーユーザーフォームが起動し、選択した日付がアクティブなセルに入力されます。

---

プロジェクト概要

機能

1. ユーザーフォームを使用してカレンダーを動的に生成します。
2. セルをダブルクリックすることでカレンダーを表示。
3. カレンダー内の日付をクリックすると、その日付がアクティブセルに入力されます。
4. 月を切り替える「前月」「次月」ボタンを提供。
5. 日曜日の文字色を赤、土曜日を青で表示。
6. カレンダーの全てのUI要素をコードで自動生成します。

---

コード詳細

1. ユーザーフォームのコード（frmCalendar）

ユーザーフォームでは以下を行います：

• 年月表示
• 曜日ラベル生成（色分け、中央揃え）
• 各日付ボタン生成（動的生成）
• 前月・次月ボタン生成
• サイズも自動生成されます

frmCalendar

Option Explicit

Private Const CELL_WIDTH As Single = 30
Private Const CELL_HEIGHT As Single = 24
Private Const MARGIN As Single = 10
Private Const HEADER_HEIGHT As Single = 30 ' 年月表示行の高さ
Private Const WEEK_HEADER_HEIGHT As Single = 24 ' 曜日ラベル行の高さ

Private CalendarButtons As Collection
Private NavButtons As Collection
Private CurrentYear As Long
Private CurrentMonth As Long
Private lblYearMonth As MSForms.Label

Private Sub UserForm_Activate()
    If CurrentYear = 0 Then
        CurrentYear = Year(Date)
        CurrentMonth = Month(Date)
        BuildCalendar CurrentYear, CurrentMonth
    End If
End Sub

Private Sub BuildCalendar(Y As Long, M As Long)
    ' カレンダーの動的生成
    Dim FirstDay As Date
    Dim LastDay As Long
    Dim dayOfWeekIndex As Long
    Dim StartPos As Long
    
    FirstDay = DateSerial(Y, M, 1)
    LastDay = Day(DateSerial(Y, M + 1, 0))
    dayOfWeekIndex = Weekday(FirstDay, vbSunday)
    StartPos = dayOfWeekIndex
    
    ClearControls
    
    Set CalendarButtons = New Collection
    Set NavButtons = New Collection
    
    ' 曜日ラベル生成
    Dim weekdays(1 To 7) As String
    weekdays(1) = "日"
    weekdays(2) = "月"
    weekdays(3) = "火"
    weekdays(4) = "水"
    weekdays(5) = "木"
    weekdays(6) = "金"
    weekdays(7) = "土"
    
    Dim w As Long
    For w = 1 To 7
        Dim lblW As MSForms.Label
        Set lblW = Me.Controls.Add("Forms.Label.1", "lblW" & w, True)
        With lblW
            .Caption = weekdays(w)
            .Width = CELL_WIDTH
            .Height = WEEK_HEADER_HEIGHT
            .Left = MARGIN + (w - 1) * CELL_WIDTH
            .Top = MARGIN + HEADER_HEIGHT
            .TextAlign = fmTextAlignCenter
            .BackColor = &H00C0C0C0 ' グレー背景
            Select Case w
                Case 1 ' 日曜日
                    .ForeColor = vbRed
                Case 7 ' 土曜日
                    .ForeColor = vbBlue
                Case Else
                    .ForeColor = vbBlack
            End Select
        End With
    Next w
    
    ' 日付ボタン生成
    Dim d As Long
    For d = 1 To LastDay
        Dim cBtn As clsCalendarButton
        Set cBtn = New clsCalendarButton
        Dim btnDay As MSForms.CommandButton
        Set btnDay = Me.Controls.Add("Forms.CommandButton.1", "btnDay" & d, True)
        
        ' ボタンのプロパティ設定
        With btnDay
            .Caption = d
            .Width = CELL_WIDTH
            .Height = CELL_HEIGHT
            .Font.Size = 10
            Dim wd As Long
            wd = Weekday(DateSerial(Y, M, d), vbSunday)
            Select Case wd
                Case 1: .ForeColor = vbRed
                Case 7: .ForeColor = vbBlue
                Case Else: .ForeColor = vbBlack
            End Select
        End With
        
        ' クラスモジュールに割り当て
        cBtn.DayValue = DateSerial(Y, M, d)
        Set cBtn.DayButton = btnDay
        CalendarButtons.Add cBtn
    Next d
End Sub

Private Sub ClearControls()
    Dim ctl As Control
    Dim delList As New Collection
    For Each ctl In Me.Controls
        delList.Add ctl
    Next ctl
    
    Dim i As Long
    For i = 1 To delList.Count
        Me.Controls.Remove delList(i).Name
    Next i
    
    Set CalendarButtons = Nothing
    Set NavButtons = Nothing
End Sub

---

2. クラスモジュール

clsCalendarButton

日付ボタンのクリックイベントを管理します。

clsCalendarButton

Option Explicit

Public WithEvents DayButton As MSForms.CommandButton
Public DayValue As Date

Private Sub DayButton_Click()
    ' 日付ボタンがクリックされた時の処理
    On Error Resume Next
    frmCalendar.Hide
    ActiveCell.Value = DayValue ' 選択中セルに日付を入力
    ' セルサイズを自動調整
    ActiveCell.EntireColumn.ColumnWidth = Len(ActiveCell.Value) + 1

    Unload frmCalendar
End Sub

clsNavButton

「前月」「次月」ボタンを管理します。

clsNavButton

Option Explicit

Public WithEvents NavBtn As MSForms.CommandButton
Public Direction As String
Public ParentForm As frmCalendar

Private Sub NavBtn_Click()
    If Direction = "Prev" Then
        ParentForm.ChangeMonth -1
    Else
        ParentForm.ChangeMonth 1
    End If
End Sub

---

3. 標準モジュール

カレンダーを表示するためのマクロです。

MainModule

Sub ShowCalendar()
    frmCalendar.Show
End Sub

---

4. ワークシートコード

セルをダブルクリックするとカレンダーを起動します。

sheetModule

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ShowCalendar
    Cancel = True
End Sub

---

使用手順

1. ユーザーフォームを作成:
   名前を frmCalendar に設定。
2. クラスモジュールを作成:
   • clsCalendarButton
   • clsNavButton
3. 標準モジュールにマクロを追加:
   ShowCalendar マクロを記述。
4. ワークシートにイベントを設定:
   Worksheet_BeforeDoubleClick にカレンダー起動コードを記述。
5. 完成！

---

このコードを利用して、Excelでのカレンダー操作が可能になります。