VBA MCSC_MONTHBKの色が反映しない
VBAのUserForm1にCreateWindowExWでカレンダーを追加し、MCSC_MONTHBKの背景色を変えたくSendMessageW hChild, MCM_SETCOLOR, MCSC_MONTHBK, &HFFFF00とコーディングしましたが反映されません、どこが悪いのでしょうか？ご教授頂ければ幸いです。
ちなみに、MCSC_BACKGROUNDの方は色が反映されました。
Windows10Pro 64、Excel2016 32ビットになります
何卒、よろしくお願いします。
UserForm1コード
Option Explicit
Private Declare Function InitCommonControlsEx& Lib "comctl32" _
(ByVal lpInitCtrl&)
Private Declare Function CreateWindowExW& Lib "user32" _
(ByVal dwExStyle&, _
ByVal lpClassName&, _
ByVal lpWindowName&, _
ByVal dwStyle&, _
ByVal x&, ByVal y&, _
ByVal nWidth&, ByVal nHeight&, _
ByVal hParent&, _
ByVal hMenu&, _
ByVal hInstance&, _
ByVal lParam&)
Private Declare Function SendMessageW& Lib "user32" _
(ByVal hwnd&, _
ByVal uMsg&, _
ByVal wParam&, _
ByVal lParam&)
Private Declare Function MoveWindow& Lib "user32" _
(ByVal hwnd&, _
ByVal x&, ByVal y&, _
ByVal nWidth&, ByVal nHeight&, _
ByVal bRepaint&)
Private Const ICC_DATE_CLASSES = &H100&
Private Const WM_SETFONT = &H30
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const MCS_DAYSTATE = 1
Private Const MCM_SETCOLOR = &H100A
Private Const MCM_GETMINREQRECT = &H1009
Private Const MCM_GETMAXTODAYWIDTH = &H1015
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_EX_WINDOWEDGE = &H100&
Private Const DTM_SETMCCOLOR = &H1006
Private Const MCSC_BACKGROUND = 0 ' 月間背景色を指定
Private Const MCSC_TEXT = 1 ' 選択日付の色
Private Const MCSC_TITLEBK = 2 ' ﾀｲﾄﾙﾊﾞｰの背景色
Private Const MCSC_TITLETEXT = 3 ' ﾀｲﾄﾙﾊﾞｰのﾃｷｽﾄ色
Private Const MCSC_MONTHBK = 4 ' ｶﾚﾝﾀﾞｰの背景色
Private Const MCSC_TRAILINGTEXT = 5
Private Sub UserForm_Initialize()
Dim ii&(1)
Dim wd&, ro#, rc&(3)
Dim fnt As stdole.IFont
Dim i&, buf&(3)
Dim hParent As Long
Dim hChild As Long
Dim fr As IOptionFrame
Dim m_hr As MSForms.IControl
Dim acc As IAccessible
Set fr = Controls.Add("Forms.Frame.1")
Set m_hr = fr
hParent = m_hr.[_GethWnd]
Set acc = fr
Set fnt = fr.Font
acc.accLocation 0, 0, wd, 0
ro = fr.Width / wd
ii(0) = 8
ii(1) = ICC_DATE_CLASSES
InitCommonControlsEx (VarPtr(ii(0)))
hChild = CreateWindowExW(WS_EX_WINDOWEDGE, _
StrPtr("SysMonthCal32"), 0, _
WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or MCS_DAYSTATE, _
0, 0, 0, 0, _
hParent, 0, 0, 0)
SendMessageW hChild, MCM_SETCOLOR, MCSC_BACKGROUND, &HFFFF00
SendMessageW hChild, MCM_SETCOLOR, MCSC_MONTHBK, &HFFFF00
SendMessageW hChild, MCM_GETMINREQRECT, 0, VarPtr(rc(0))
i = SendMessageW(hChild, MCM_GETMAXTODAYWIDTH, 0, 0)
MoveWindow hChild, 0, 0, i + 100, rc(3), 0
With fr
.Width = (i + 100) * ro
.Height = rc(3) * ro
End With
End Sub
お礼
SystemParametersInfoでやってみたのですがうまくパラメータの設定ができず、VCでやってみたらできました。 回答ありがとうございました。