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


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

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

---

## プロジェクト概要

### 機能

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

---

## コード詳細

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

ユーザーフォームでは以下を行います：
- 年月表示
- 曜日ラベル生成（色分け、中央揃え）
- 各日付ボタン生成（動的生成）
- 前月・次月ボタン生成
- サイズも自動生成されます

```vba: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`
日付ボタンのクリックイベントを管理します。

```vba: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`
「前月」「次月」ボタンを管理します。

```vba: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. **標準モジュール**

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

```vba:MainModule
Sub ShowCalendar()
    frmCalendar.Show
End Sub
```

---

### 4. **ワークシートコード**

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

```vba: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でのカレンダー操作が可能になります。