【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を利用します。
それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。
FindWindow関数 ：ウィンドウのハンドルを取得する
FindWindowEx関数 ：子ウィンドウのハンドルを取得する
GetWindowLongPtr関数 ：アプリケーションインスタンスのハンドルを取得する
InitCommonControlsEx関数：コモンコントロールを初期化(クラス登録)する
CreateWindowEx関数 ：ウィンドウ(コントロール)を作成する
DestroyWindow関数 ：ウィンドウ(コントロール)を破棄する
SendMessage関数 ：ウィンドウにメッセージを送信する
「そもそもWindows APIって何？」という方はコチラ(メインページ)も併せて参照下さい。
サンプルコード
UserFormに日付選択コントロールを作成するためのサンプルコードは下記の通りです。
上画像の通り「CommandButton1」と「ComboBox1」の2つのコントロールを作成したUserFormのコードとして下記コードを使用してください。下記コードコピペ後、そのUserFormを表示するだけで、ComboBoxの位置に日付選択コントロールが作成されます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
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 GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function InitCommonControlsEx Lib "comctl32" (lpInitCtrls As tagINITCOMMONCONTROLSEX) As Long 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 Const ICC_DATE_CLASSES = &H100 Private Const DTS_SHORTDATEFORMAT = &H0 'YYYY/MM/DD Private Const DTS_LONGDATEFORMAT = &H4 'YYYY年MM月DD日 Private Const GWL_HINSTANCE As Long = (-6) 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 tagINITCOMMONCONTROLSEX dwSize As Long dwICC As Long End Type 'ｼｽﾃﾑﾀｲﾑ構造体 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 hWndForm As LongPtr Private hWndClient As LongPtr Private hWndExcel As LongPtr Private hWndDate As LongPtr Private hInst As LongPtr Private tSysTime As SYSTEMTIME '------------------------------------------------------------------ ' UserForm起動時ｲﾍﾞﾝﾄ '------------------------------------------------------------------ Private Sub UserForm_Initialize() Dim tInitCmnCtrl As tagINITCOMMONCONTROLSEX Dim lRet As Long 'UserFormのｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ取得 hWndForm = FindWindow("ThunderDFrame", Me.Caption) hWndClient = FindWindowEx(hWndForm, 0, vbNullString, vbNullString) 'ｺﾓﾝｺﾝﾄﾛｰﾙ初期化 With tInitCmnCtrl .dwICC = ICC_DATE_CLASSES .dwSize = Len(tInitCmnCtrl) End With lRet = InitCommonControlsEx(tInitCmnCtrl) 'ｱﾌﾟﾘｹｰｼｮﾝ(Excel)のｲﾝｽﾀﾝｽﾊﾝﾄﾞﾙ取得 hWndExcel = FindWindow("XLMAIN", Application.Caption) hInst = GetWindowLongPtr(hWndExcel, GWL_HINSTANCE) '日付選択ｺﾝﾄﾛｰﾙ作成 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, hInst, vbNullString) 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 '日付選択ｺﾝﾄﾛｰﾙの値取得 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 PtToPx = dPt * 96 / 72 End Function |
コード解説
UserFormのクライアント領域のウィンドウハンドル取得
ウィンドウにはそれぞれを識別するためにウィンドウハンドルと呼ばれるIDが割り当てられています。WindowsAPIでウィンドウの情報を取得したり操作する際には、このウィンドウハンドルを使って行います。今回のケースでは、日付選択コントロールを作成する場所の情報として必要になります。
ウィンドウハンドルを取得する方法はいくつも存在しますがここでは常套手段のFindWindow関数を使ってウィンドウハンドルを取得しています。FindWindow関数は下記のように記載することで指定のクラス名もしくはウィンドウ名から該当のウィンドウへのハンドルを取得することができます。(UserFoemの場合はクラス名に「”ThunderDFrame”」、ウィンドウ名に「Me.Caption」で取得可能)
hWnd = FindWindow(“クラス名”, “ウィンドウ名”)
UserFormのウィンドウハンドル取得後、クライアント領域のウィンドウハンドルを取得します。
クライアント領域とはウィンドウのタイトルバーやメニューバーなどを除いたエリアのことを指し、UserFormでいうとコントロールの作成ができるエリアのことです。FindWindow関数で取得したウィンドウハンドルはUserForm全体のハンドルであり、クライアント領域と非クライアント領域が合わさったエリアとなっています。(非クライアント領域=クライアントエリア以外のエリア)
日付選択コントロールを作成するためにはコントロールを作成するエリア、つまりはUserFormのクライアント領域のハンドルが必要となります。UserFormは構造上、1つ子供のウィンドウハンドルを取得すればそれがクライアント領域のハンドルとなっています。そのため子ウィンドウのハンドルを取得できるFindWindowEx関数を使って下記のように書くことでUserFormのクライアント領域のハンドルを取得することができます。(第1引数のhWndはUserFormのウィンドウハンドル)
hWndClient = FindWindowEx(hWnd, 0, vbNullString, vbNullString)
FindWindowEx関数は引数の値から複数ある子ウィンドウから条件に合う対象の子ウィンドウへのハンドルを取得する関数ですが、UserFormの場合は子ウィンドウは1つしかないため上記のような無条件の引数でクライアント領域へのハンドルが取得ができます。
コモンコントロール初期化
Windowsにはツールバーやステータスバー、ツリービューをはじめとした「コモンコントロール」と呼ばれるコントロール群が登録されており、日付選択コントロールもこのコモンコントロールに含まれています。コモンコントロールを新規作成するには事前にInitCommonControlsEx関数を呼使って対象のコモンコントロールをメモリ上にロードさせておく必要があります。
本関数には引数にINITCOMMONCONTROLSEX構造体を入力しますが、予め構造体の要素に値を入力しておく必要があります。dwICCには新規作成するコモンコントロールを表すフラグを入力しておく必要があり、日付選択コントロールの場合は「ICC_DATE_CLASSES (&H100)」を入力します。dwSizeには構造体のサイズ、つまりは「Len(構造体)」を入力すれば問題ありません。
With tInitCmnCtrl
.dwICC = ICC_DATE_CLASSES ‘&H100
.dwSize = Len(tInitCmnCtrl)
End With
lRet = InitCommonControlsEx(tInitCmnCtrl)
上記のように書くことで日付選択コントロールの初期化は完了です。
その他のコモンコントロールを表すフラグ値はリンク先に表記されています。
アプリケーションのインスタンスハンドル取得
コモンコントロールを作成する場合はどのアプリケーションに作成するかを定義する必要があります。このとき使われるのがアプリケーションのインスタンスハンドルです。ウィンドウハンドルはウィンドウを表していたのに対して、インスタンスハンドルは”アプリケーションそのもの”を表しています。
hWndExcel = FindWindow(“XLMAIN”, Application.Caption)
hInst = GetWindowLongPtr(hWndExcel, GWL_HINSTANCE)
インスタンスハンドルはGetWindowLongPtr関数の第1引数に該当のアプリケーションのウィンドウハンドル、第2引数に「GWL_HINSTANCE (-6)」を入力することで戻り値として取得することができます。ウィンドウハンドルは前項と同じくFindWindow関数を使ってExcelのウィンドウハンドルを取得しています。(※ウィンドウハンドルの取得さえできれば他のアプリケーションでも使用可能)
日付選択コントロール作成
コモンコントロールを新規作成する場合はCreateWindowEx関数を使います。
|
1 2 3 4 5 6 |
'日付選択ｺﾝﾄﾛｰﾙ作成 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, hInst, vbNullString) |
引数は非常に多く、基本的には上記の通り記載すれば問題ありません。
このとき、値を変えることのある引数は第4～8引数で、それ以外は基本的に定数値です。
第4引数には作成するコントロールのウィンドウスタイルを入力していますが、日付選択コントロールの場合、「DTS_SHORTDATEFORMAT」や「DTS_LONGDATEFORMAT」などの専用のフラグがあり、日付の表示フォーマットを変更することができます。年月日を／区切りにするというような設定であったり、さらに細かくフォーマットを設定することができるスタイルも用意されています。
第5～8引数は作成するコントロールの位置と大きさを入力します。サンプルコードでは事前に作成しておいたComboBoxと同じ位置、サイズになるような値を入力しています。本関数の入力値の単位はピクセル(px)のため、UserForm上の単位ポイント(pt)を変換するための関数を通しています。位置調整のためにComboBoxを用意していますが、定数を直接入力しても問題ありません。
CreateWindowEx関数で作成したコントロールは不要になったら、DestroyWindow関数を使って明示的に破棄する必要があります。本関数を通さずに処理を終えてしまうとメモリリークを起こす原因となるため注意が必要です。(サンプルコードではTerminateイベントで実行)
Call DestroyWindow(hWndDate)
引数として破棄するコントロール(ウィンドウ)のハンドルを入力します。CreateWindowEx関数は作成したコントロールのウィンドウハンドルを戻り値として返すため、その値をそのまま入力すれば作成した日付選択コントロールを破棄することができます。
日付選択コントロールの値取得
日付選択コントロールの値を取得するには、SendMessage関数を使って値を取得する対象の日付選択コントロールのウィンドウハンドルに値取得メッセージを送信する必要があります。
lRet = SendMessage(hWndDate, DTM_GETSYSTEMTIME, 0, tSysTime)
第1引数には日付選択コントロールのウィンドウハンドル、第2引数には送信するメッセージ(値取得)、第4引数には取得した時間を格納するためのSYSTEMTIME構造体をそれぞれ入力します。
これにより、日付選択コントロールの現在の値を取得することができます。このとき年月日や曜日などはSYSTEMTIME構造体の各要素ごとに分かれてそれぞれ取得されます。各要素の定義についてはSYSTEMTIME構造体ページを参照下さい。
日付選択コントロール自体の値変更イベントはないため、UserFormの標準で用意されている何らかのイベントで本処理を行う必要があります。今回の内容よりさらに深い領域であるUserFormのサブクラス化をすることで日付選択コントロールの値変更イベントの作成も可能です。
関連情報
VBA×WindowsAPIまとめページ
その他のWindowsAPI関数は下記ページにまとまっているので合わせて参照下さい。
https://liclog.net/vba-windows-api-index/参考
Microsoft公式：日付と時刻の選択コントロールについて – Win32 apps
