【VBA×WindowsAPI】UserFormに日付選択コントロール(カレンダー)を作成する

VBAで日付を入力させる際にカレンダーから選択させたいという場面に出くわすことがあります。少し前ですとAccessのカレンダーコントロールを使うことで実現できましたが、現在のバージョンでは廃止されて使うことが出来なくなっており、VBAだけで再現することは実質不可能となっています。

自作でカレンダーフォームを作るのもアリですが、WindowsAPIを使うことで旧Accessのカレンダーコントロールと同等の日付選択コントロールを作成することができます。コードの難易度としては高いものとなっていますが、Windowsで用意されているコントロールのためかなり使い勝手の良いコントロールとなっており、もちろんアプリケーションによる縛りはありません。

UserFormに日付選択コントロールを作成する

WindowsAPIを使うことで、上画像のようにUserForm上に日付選択用のカレンダーコントロールを作成することができます。コントロールの仕様としてはほとんど旧Accessのカレンダーコントロールと同じで、説明がなくとも簡単に扱うことのできるUIとなっています。日付の表記は「YYYY/MM/DD」や「YYYY年MM月DD日」などのように任意のフォーマットに切り替えることも可能です。

この日付選択コントロールはWindowsAPIを使って新たに生成されたコントロールのため、UserFormの標準コントロールとは違いオブジェクトとして存在はしません。そのため値変更や位置の変更、イベントの設定などは基本的には行うことができないので注意が必要です。

VBAでUserFormに日付選択コントロールを作成するには下記のWindows APIを利用します。
それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。

icon-check-square FindWindow関数         　：ウィンドウのハンドルを取得する
icon-check-square FindWindowEx関数     　：子ウィンドウのハンドルを取得する
icon-check-square CreateWindowEx関数  　：ウィンドウ(コントロール)を作成する
icon-check-square DestroyWindow関数    　：ウィンドウ(コントロール)を破棄する
icon-check-square SendMessage関数      　 ：ウィンドウにメッセージを送信する
icon-check-square GetDC関数          　      　：デバイスコンテキスト(DC)を取得する
icon-check-square ReleaseDC関数           　 ：指定のDCを解放する
icon-check-square GetDeviceCaps関数     　：デバイス情報(画面解像度)を取得する

「そもそもWindows APIって何？」という方はコチラ(メインページ)も併せて参照下さい。

サンプルコード

UserFormに日付選択コントロールを作成するためのサンプルコードは下記の通りです。
上画像の通り「CommandButton1」と「ComboBox1」の2つのコントロールを作成したUserFormのコードとして下記コードを使用してください。下記コードコピペ後、そのUserFormを表示するだけで、ComboBoxの位置に日付選択コントロールが作成されます。

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long

Private Const DTS_SHORTDATEFORMAT = &H0     'YYYY/MM/DD
Private Const DTS_LONGDATEFORMAT = &H4      'YYYY年MM月DD日

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_GROUP = &H20000

Private Const DTM_FIRST = &H1000
Private Const DTM_GETSYSTEMTIME = (DTM_FIRST + 1)   'ｺﾝﾄﾛｰﾙの日付/時刻を取得
Private Const DTM_SETSYSTEMTIME = (DTM_FIRST + 2)   'ｺﾝﾄﾛｰﾙの日付/時刻をｾｯﾄ
Private Const DTM_GETRANGE = (DTM_FIRST + 3)        'ｺﾝﾄﾛｰﾙの日付範囲を取得
Private Const DTM_SETRANGE = (DTM_FIRST + 4)        'ｺﾝﾄﾛｰﾙの日付範囲を設定

'ｼｽﾃﾑﾀｲﾑ構造体
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private hWndDate As LongPtr

'------------------------------------------------------------------
'   UserForm起動時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    Dim hWndForm As LongPtr
    Dim hWndClient As LongPtr
        
    'UserFormのｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ取得
    hWndForm = FindWindow("ThunderDFrame", Me.caption)
    hWndClient = FindWindowEx(hWndForm, 0, vbNullString, vbNullString)

    '日付選択ｺﾝﾄﾛｰﾙ作成
    hWndDate = CreateWindowEx(0, "SysDateTimePick32", vbNullString, _
                              WS_CHILD Or WS_VISIBLE Or DTS_SHORTDATEFORMAT Or WS_GROUP, _
                              PtToPx(Me.ComboBox1.Left), PtToPx(Me.ComboBox1.Top), _
                              PtToPx(Me.ComboBox1.Width), PtToPx(Me.ComboBox1.Height), _
                              hWndClient, 0, 0, 0)

End Sub
'------------------------------------------------------------------
'   UserForm終了時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Terminate()
 
    '日付選択ｺﾝﾄﾛｰﾙを破棄
    Call DestroyWindow(hWndDate)
 
End Sub

'------------------------------------------------------------------
'   ｺﾏﾝﾄﾞﾎﾞﾀﾝ押下ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub CommandButton1_Click()

    Dim lRet As LongPtr
    Dim sMsg As String
    Dim sDayOfWeek As String
    Dim tSysTime As SYSTEMTIME
    
    '日付選択ｺﾝﾄﾛｰﾙの値取得
    lRet = SendMessage(hWndDate, DTM_GETSYSTEMTIME, 0, tSysTime)

    '取得した値から年/月/日/曜日を取得
    Select Case tSysTime.wDayOfWeek
        Case 0: sDayOfWeek = "日曜日"
        Case 1: sDayOfWeek = "月曜日"
        Case 2: sDayOfWeek = "火曜日"
        Case 3: sDayOfWeek = "水曜日"
        Case 4: sDayOfWeek = "木曜日"
        Case 5: sDayOfWeek = "金曜日"
        Case 6: sDayOfWeek = "土曜日"
    End Select

    sMsg = "年:　 " & tSysTime.wYear & vbLf & _
           "月:　 " & tSysTime.wMonth & vbLf & _
           "日:　 " & tSysTime.wDay & vbLf & _
           "曜日: " & sDayOfWeek
           
    '取得した日付を表示
    Call MsgBox(sMsg)
    
End Sub

'------------------------------------------------------------------
'   ﾎﾟｲﾝﾄ(pt)→ﾋﾟｸｾﾙ(px)変換
'------------------------------------------------------------------
Function PtToPx(ByVal dPt As Double) As Double

    Dim hDc As LongPtr
    Dim lDpiX As Long
    
    hDc = GetDC(0)
    lDpiX = GetDeviceCaps(hDc, 88) '88 = LOGPIXELSX
    Call ReleaseDC(0, hDc)
    
    PtToPx = dPt * lDpiX / 72
    
End Function

コード解説

icon-edit UserFormのクライアント領域のウィンドウハンドル取得

ウィンドウにはそれぞれを識別するためにウィンドウハンドルと呼ばれるIDが割り当てられています。WindowsAPIでウィンドウの情報を取得したり操作する際には、このウィンドウハンドルを使って行います。今回のケースでは、日付選択コントロールを作成する場所の情報として必要になります。

ウィンドウハンドルを取得する方法はいくつも存在しますがここでは常套手段のFindWindow関数を使ってウィンドウハンドルを取得しています。FindWindow関数は下記のように記載することで指定のクラス名もしくはウィンドウ名から該当のウィンドウへのハンドルを取得することができます。(UserFormの場合はクラス名に「"ThunderDFrame"」、ウィンドウ名に「Me.Caption」で取得可能)

icon-code FindWindow関数 

hWnd = FindWindow(“クラス名", “ウィンドウ名")

UserFormのウィンドウハンドル取得後、クライアント領域のウィンドウハンドルを取得します。

クライアント領域とはウィンドウのタイトルバーやメニューバーなどを除いたエリアのことを指し、UserFormでいうとコントロールの作成ができるエリアのことです。FindWindow関数で取得したウィンドウハンドルはUserForm全体のハンドルであり、クライアント領域と非クライアント領域が合わさったエリアとなっています。(非クライアント領域=クライアントエリア以外のエリア)

日付選択コントロールを作成するためにはコントロールを作成するエリア、つまりはUserFormのクライアント領域のハンドルが必要となります。UserFormは構造上、1つ子供のウィンドウハンドルを取得すればそれがクライアント領域のハンドルとなっています。そのため子ウィンドウのハンドルを取得できるFindWindowEx関数を使って下記のように書くことでUserFormのクライアント領域のハンドルを取得することができます。(第1引数のhWndはUserFormのウィンドウハンドル)

icon-code FindWindowEx関数 

hWndClient = FindWindowEx(hWnd, 0, vbNullString, vbNullString)

FindWindowEx関数は引数の値から複数ある子ウィンドウから条件に合う対象の子ウィンドウへのハンドルを取得する関数ですが、UserFormの場合は子ウィンドウは1つしかないため上記のような無条件の引数でクライアント領域へのハンドルが取得ができます。
　

icon-edit 日付選択コントロール作成

Windowsにはツールバーやステータスバー、ツリービューをはじめとした「コモンコントロール」と呼ばれるコントロール群が登録されており、日付選択コントロールもこのコモンコントロールに含まれています。コモンコントロールを新規作成する場合はCreateWindowEx関数を使います。

    '日付選択ｺﾝﾄﾛｰﾙ作成
    hWndDate = CreateWindowEx(0, "SysDateTimePick32", vbNullString, _
                              WS_CHILD Or WS_VISIBLE Or DTS_SHORTDATEFORMAT Or WS_GROUP, _
                              PtToPx(Me.ComboBox1.Left), PtToPx(Me.ComboBox1.Top), _
                              PtToPx(Me.ComboBox1.Width), PtToPx(Me.ComboBox1.Height), _
                              hWndClient, 0, 0, 0)

引数は非常に多く、基本的には上記の通り記載すれば問題ありません。
このとき、値を変えることのある引数は第4～8引数で、それ以外は基本的に定数値です。

第4引数には作成するコントロールのウィンドウスタイルを入力していますが、日付選択コントロールの場合、「DTS_SHORTDATEFORMAT」や「DTS_LONGDATEFORMAT」などの専用のフラグがあり、日付の表示フォーマットを変更することができます。年月日を／区切りにするというような設定であったり、さらに細かくフォーマットを設定することができるスタイルも用意されています。

第5～8引数は作成するコントロールの位置と大きさを入力します。サンプルコードでは事前に作成しておいたComboBoxと同じ位置、サイズになるような値を入力しています。本関数の入力値の単位はピクセル(px)のため、UserForm上の単位ポイント(pt)を変換するための関数を通しています。位置調整のためにComboBoxを用意していますが、定数を直接入力しても問題ありません。

CreateWindowEx関数で作成したコントロールは不要になったら、DestroyWindow関数を使って明示的に破棄する必要があります。本関数を通さずに処理を終えてしまうとメモリリークを起こす原因となるため注意が必要です。(サンプルコードではTerminateイベントで実行)

icon-code SendMessage関数 

Call DestroyWindow(hWndDate)

引数として破棄するコントロール(ウィンドウ)のハンドルを入力します。CreateWindowEx関数は作成したコントロールのウィンドウハンドルを戻り値として返すため、その値をそのまま入力すれば作成した日付選択コントロールを破棄することができます。
　

icon-edit 日付選択コントロールの値取得

日付選択コントロールの値を取得するには、SendMessage関数を使って値を取得する対象の日付選択コントロールのウィンドウハンドルに値取得メッセージを送信する必要があります。

icon-code SendMessage関数 

lRet = SendMessage(hWndDate, DTM_GETSYSTEMTIME, 0, tSysTime)

第1引数には日付選択コントロールのウィンドウハンドル、第2引数には送信するメッセージ(値取得)、第4引数には取得した時間を格納するためのSYSTEMTIME構造体をそれぞれ入力します。

これにより、日付選択コントロールの現在の値を取得することができます。このとき年月日や曜日などはSYSTEMTIME構造体の各要素ごとに分かれてそれぞれ取得されます。各要素の定義についてはSYSTEMTIME構造体ページを参照下さい。

日付選択コントロール自体の値変更イベントはないため、UserFormの標準で用意されている何らかのイベントで本処理を行う必要があります。今回の内容よりさらに深い領域であるUserFormのサブクラス化をすることで日付選択コントロールの値変更イベントの作成も可能です。

関連情報

icon-share-square VBA×WindowsAPIまとめページ

その他のWindowsAPI関数は下記ページにまとまっているので合わせて参照下さい。

icon-share-square 参考

Microsoft公式：日付と時刻の選択コントロールについて – Win32 apps

大村あつしのExcel VBA Win64/32 APIプログラミング
created by Rinker

2025年9月12日Excel,VBA,Windows API