MENU
ITで縁を紡ぐ
お問合せ
  1. ホーム
  2. Excel
  3. 【VBA】コピペ実行で作れるカレンダーフォーム（実践例も紹介）

【VBA】コピペ実行で作れるカレンダーフォーム（実践例も紹介）

広告
Excel

こんにちは！大阪市を拠点に活動している『縁紡ぐ』の稲垣です。

SWELLを使ったホームページ制作や、Excel、ACCESS、RPAなどのシステム開発を行っています。
また、Excel、Word、Outlookの研修や、情報セキュリティ研修も行っています。身近なITの相談相手になりたいと思っています。

お気軽にお問い合わせください。

目次

VBAでカレンダー入力を作成する

作り方の手順

STEP
標準モジュールに下記コードをコピペする
Sub CreateCalendarForm()
    Dim myForm As Object
    Dim btn As MSForms.CommandButton
    Dim lbl As MSForms.Label
    Dim i As Integer, j As Integer
    Dim dayBtn As MSForms.CommandButton

    ' ユーザーフォームの作成
    Set myForm = ThisWorkbook.VBProject.VBComponents.Add(ComponentType:=3)
    With myForm
        .Name = "Calendar"
        .Properties("Caption") = "カレンダー"
        .Properties("Width") = 350
        .Properties("Height") = 350
    End With

    ' 月表示ラベルの作成
    Set lbl = myForm.Designer.Controls.Add("Forms.Label.1", "lblMonth", True)
    lbl.Top = 18
    lbl.Left = 125
    lbl.Width = 130
    lbl.Height = 20
    lbl.Font.Name = "BIZ UDPゴシック"
    lbl.Font.Size = 14

    ' 前月ボタンの作成
    Set btn = myForm.Designer.Controls.Add("Forms.CommandButton.1", "btnPrevMonth", True)
    btn.Caption = "前月"
    btn.Top = 10
    btn.Left = 10
    btn.Width = 50
    btn.Height = 30
    btn.Font.Name = "BIZ UDPゴシック"
    btn.Font.Size = 14

    ' 次月ボタンの作成
    Set btn = myForm.Designer.Controls.Add("Forms.CommandButton.1", "btnNextMonth", True)
    btn.Caption = "次月"
    btn.Top = 10
    btn.Left = 280
    btn.Width = 50
    btn.Height = 30
    btn.Font.Name = "BIZ UDPゴシック"
    btn.Font.Size = 14

    ' 曜日ラベルの作成
    Dim weekdays As Variant
    weekdays = Array("日", "月", "火", "水", "木", "金", "土")
    For j = 0 To 6
        Set lbl = myForm.Designer.Controls.Add("Forms.Label.1", "lblWeekday" & j, True)
        lbl.Top = 50
        lbl.Left = 10 + j * 45
        lbl.Width = 40
        lbl.Height = 20
        lbl.Caption = weekdays(j)
        lbl.TextAlign = fmTextAlignCenter
        lbl.Font.Name = "BIZ UDPゴシック"
        lbl.Font.Size = 14
        If j = 0 Then
            lbl.ForeColor = RGB(255, 0, 0) ' 赤
        ElseIf j = 6 Then
            lbl.ForeColor = RGB(0, 0, 255) ' 青
        End If
    Next j

    ' 日付ボタンの作成
    For i = 0 To 5
        For j = 0 To 6
            Set dayBtn = myForm.Designer.Controls.Add("Forms.CommandButton.1", "Day" & (i * 7 + j + 1), True)
            dayBtn.Top = 80 + i * 30
            dayBtn.Left = 10 + j * 45
            dayBtn.Width = 40
            dayBtn.Height = 30
            dayBtn.Caption = ""
            dayBtn.Font.Name = "BIZ UDPゴシック"
            dayBtn.Font.Size = 14
            ' 日曜日を赤、土曜日を青に設定
            If j = 0 Then
                dayBtn.ForeColor = RGB(255, 0, 0) ' 赤
            ElseIf j = 6 Then
                dayBtn.ForeColor = RGB(0, 0, 255) ' 青
            End If
        Next j
    Next i

    ' イベントハンドラーの設定
    With ThisWorkbook.VBProject.VBComponents(myForm.Name).codeModule
        .InsertLines .CountOfLines + 1, "Private currentYear As Integer"
        .InsertLines .CountOfLines + 1, "Private currentMonth As Integer"
        .InsertLines .CountOfLines + 1, "Private Sub UserForm_Initialize()"
        .InsertLines .CountOfLines + 1, "    currentYear = Year(Date)"
        .InsertLines .CountOfLines + 1, "    currentMonth = Month(Date)"
        .InsertLines .CountOfLines + 1, "    ShowCalendar currentYear, currentMonth"
        .InsertLines .CountOfLines + 1, "End Sub"
        
        .InsertLines .CountOfLines + 1, "Private Sub ShowCalendar(Year As Integer, Month As Integer)"
        .InsertLines .CountOfLines + 1, "    Dim startDate As Date"
        .InsertLines .CountOfLines + 1, "    Dim endDate As Date"
        .InsertLines .CountOfLines + 1, "    Dim firstDay As Integer"
        .InsertLines .CountOfLines + 1, "    Dim i As Integer"
        .InsertLines .CountOfLines + 1, "    startDate = DateSerial(Year, Month, 1)"
        .InsertLines .CountOfLines + 1, "    endDate = DateSerial(Year, Month + 1, 0)"
        .InsertLines .CountOfLines + 1, "    firstDay = Weekday(startDate, vbSunday)"
        .InsertLines .CountOfLines + 1, "    For i = 1 To 42"
        .InsertLines .CountOfLines + 1, "        Me.Controls(""Day"" & i).Caption = """""
        .InsertLines .CountOfLines + 1, "    Next i"
        .InsertLines .CountOfLines + 1, "    For i = 1 To (endDate - startDate + 1)"
        .InsertLines .CountOfLines + 1, "        Me.Controls(""Day"" & (firstDay - 1 + i)).Caption = i"
        .InsertLines .CountOfLines + 1, "    Next i"
        .InsertLines .CountOfLines + 1, "    Me.lblMonth.Caption = Year & ""年"" & Month & ""月"""
        .InsertLines .CountOfLines + 1, "End Sub"
        
        .InsertLines .CountOfLines + 1, "Private Sub btnPrevMonth_Click()"
        .InsertLines .CountOfLines + 1, "    currentMonth = currentMonth - 1"
        .InsertLines .CountOfLines + 1, "    If currentMonth < 1 Then"
        .InsertLines .CountOfLines + 1, "        currentMonth = 12"
        .InsertLines .CountOfLines + 1, "        currentYear = currentYear - 1"
        .InsertLines .CountOfLines + 1, "    End If"
        .InsertLines .CountOfLines + 1, "    ShowCalendar currentYear, currentMonth"
        .InsertLines .CountOfLines + 1, "End Sub"
        
        .InsertLines .CountOfLines + 1, "Private Sub btnNextMonth_Click()"
        .InsertLines .CountOfLines + 1, "    currentMonth = currentMonth + 1"
        .InsertLines .CountOfLines + 1, "    If currentMonth > 12 Then"
        .InsertLines .CountOfLines + 1, "        currentMonth = 1"
        .InsertLines .CountOfLines + 1, "        currentYear = currentYear + 1"
        .InsertLines .CountOfLines + 1, "    End If"
        .InsertLines .CountOfLines + 1, "    ShowCalendar currentYear, currentMonth"
        .InsertLines .CountOfLines + 1, "End Sub"
        
        .InsertLines .CountOfLines + 1, "Private Sub Day_Click(ByVal selectDay As Integer)"
        .InsertLines .CountOfLines + 1, "    If selectDay > 0 Then"
        .InsertLines .CountOfLines + 1, "        MsgBox ""選択された日付: "" & currentYear & ""/"" & currentMonth & ""/"" & selectDay"
        .InsertLines .CountOfLines + 1, "    End If"
        .InsertLines .CountOfLines + 1, "End Sub"
        
        ' イベントハンドラを追加
        For i = 1 To 42
            .InsertLines .CountOfLines + 1, "Private Sub day" & i & "_Click()"
            .InsertLines .CountOfLines + 1, "    Dim day As Integer"
            .InsertLines .CountOfLines + 1, "    If Me.Day" & i & ".Caption <> """" Then"
            .InsertLines .CountOfLines + 1, "        day = CInt(Me.Day" & i & ".Caption)"
            .InsertLines .CountOfLines + 1, "    Else"
            .InsertLines .CountOfLines + 1, "        day = 0"
            .InsertLines .CountOfLines + 1, "    End If"
            .InsertLines .CountOfLines + 1, "    Call Day_Click(day)"
            .InsertLines .CountOfLines + 1, "End Sub"
        Next i
    End With

    ' ユーザーフォームを表示
    VBA.UserForms.Add(myForm.Name).Show
End Sub
STEP
モジュールをF5で実行

これで完成

STEP
日付をクリックすると押した日付が表示される

カレンダーで入力された値を取得する方法

上記で紹介したコードは、カレンダーの日付を押すとメッセージボックスで選択した日付が表示されるまでです。実際にカレンダーフォームを使うときは、別のフォームやセルに対して、選択した日付を表示したいと思います。

グローバル変数で選択された日付を受け渡す

とっても簡単な方法です。標準モジュールに、グローバル変数を追加して、他のフォームでも変数を使えるようにする方法です。

STEP
標準モジュールにグローバル変数を追加（今回はモジュール名をGlobalVariablesとする）
'GlobalVariables
Public selectedDate As Date
Public dateSelected As Boolean
STEP
カレンダー初期化イベントにグローバル変数も初期化する
’Calender
Private Sub UserForm_Initialize()
    currentYear = Year(Date)
    currentMonth = Month(Date)
    ShowCalendar currentYear, currentMonth
    GlobalVariables.selectedDate = #12/31/2099#　'追加
    GlobalVariables.dateSelected = False　'追加
End Sub
STEP
CalenderのDay_Clickプロシージャのコードを変更
'Calender
Private Sub Day_Click(ByVal selectDay As Integer)
    'MsgBox "選択された日付: " & currentYear & "/" & currentMonth & "/" & selectDay コメントアウト
    GlobalVariables.selectedDate = currentYear & "/" & currentMonth & "/" & selectDay '追加
    GlobalVariables.dateSelected = True '追加
    Me.hide ’追加
End Sub
STEP
呼び出し元のフォームのテキストボックスにイベントを追加

日付用のテキストボックスにフォーカスする前にCalenderが呼び出されるように設定し、カレンダーで選ばれた日付

Private Sub CommandButton1_Click()
    ' カレンダーフォームの表示
    Calendar.show
    ' 日付が選択されたか確認
    If GlobalVariables.dateSelected Then
        ' テキストボックスに表示する
        Me.TextBox1 = GlobalVariables.selectedDate
    End If
End Sub

カレンダーのメンバー変数を設定し呼び出し元で取得する方法

呼び出し元でカレンダーフォームをインスタンス化して取得する方法です。dateSele

STEP
Calenderのメンバー変数に変数を追加
Private selectedDate As Date
Private dateSeeclted As Boolean
STEP
メンバー変数にアクセスするためのGetterとSetterをCalenderに追加
Public Sub setSelectedDate(ByVal prmDate As Date)
    selectedDate = prmDate
End Sub
Public Function getSelectedDate() As Date
    getSelectedDate = selectedDate
End Function

Public Sub setDateSelected(ByVal dateSelected As Boolean)
    dateSelected = prmDateSelected
End Sub
Public Function getDateSelected() As Boolean
    getDateSelected = dateSeeclted
End Function

GetterとSetterの命名については、お好みの方法に変更してください。

STEP
Calenderの日付クリック時のDay_Clickプロシージャを変更
Private Sub Day_Click(ByVal selectDay As Integer)
    Me.setSelectedDate (currentYear & "/" & currentMonth & "/" & selectDay)
    Me.setDateSelected (True)
    Me.hide
End Sub
STEP
呼び出し元にカレンダーフォームをインスタンス化して、Getterを使って値を取得する
Private Sub CommandButton1_Click()
    ' カレンダーフォームのインスタンス化と表示
    Dim calendarForm As Calendar
    Set calendarForm = New Calendar
    calendarForm.show vbModal
    
    On Error Resume Next
    
    ' 日付が選択されたか確認
    If calendarForm.getDateSelected() Then
        MsgBox "選択された日付: " & calendarForm.getSelectedDate
        ' テキストボックスに表示する
        Me.TextBox1 = Format(calendarForm.getSelectedDate, "yyyy/mm/dd")
    Else
        MsgBox "日付が選択されませんでした。"
    End If
    
    On Error GoTo 0 ' エラーハンドリングを解除
    
    ' オブジェクトの解放
    Set calendarForm = Nothing
End Sub

On Error Resume Nextは、カレンダーを×で閉じられた時の対応のため。

×を表示したくない時の方法は、こちらをご覧ください。

縁紡ぐ
【VBA】ユーザーフォームの×閉じるボタンを無効にする方法 | 縁紡ぐ 【VBA】ユーザーフォームの×閉じるボタンを無効にする方法 ユーザーフォームの×閉じるを無効化する方法 ユーザーフォームのプロパティには、この閉じるボタンを無効化する…

まとめ

日付の入力がカレンダー形式でできると、曜日もすぐにわかり操作性が向上しますので、ぜひ記事を参考に活用してください。

記事を書いた人

稲垣

  • Excel、ACCESSでのシステム開発が得意
  • ITスキルを共有し実践的に学びながら成長する人を見るのが幸せ
  • 自家焙煎するほどのコーヒー好き
  • 使用言語 VBA、Python、Javascript、Java、HTML、CSS etc.
  • 保有資格　Kintoneアソシエイト、日商簿記検定２級、マンション管理士、管理業務主任者、情報セキュリティマネジメント、ExcelVBA　etc.
  • 業務フロー図の作成や業務時間分析を通して、効率化ポイントを探る人
  • お客様にとって本当に良いことかを第一に考える人
Excel
よかったらシェアしてね！
  • URLをコピーしました！
  • URLをコピーしました！

コメント

コメントする

目次