ExcelVBA技
ユーザーフォーム
E13U011
E13U011 (Excel2000~2013)
ユーザーフォームのタイトルバー非表示
ユーザーフォームのタイトルバーを非表示にするkStyleCaption関数を示します。
スプラッシュウィンドウやプロパティウィンドウ・プログレスバー等に用いることが出来ます。
'フォーム モジュール Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function WindowFromObject Lib "oleacc" Alias "WindowFromAccessibleObject" _ (ByVal pacc As Object, phwnd As LongPtr) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" _ (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" _ (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long #Else Private Declare Function WindowFromObject Lib "oleacc" Alias "WindowFromAccessibleObject" _ (ByVal pacc As Object, phwnd As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long #End If Const GWL_STYLE = (-16&) Const GWL_EXSTYLE = (-20&) Const WS_CAPTION = &HC00000 Const WS_EX_DLGMODALFRAME = &H1& 'kStyleCaption関数 'ユーザーフォームのタイトルバー非表示 '引数:uf ユーザーフォーム ' flat True=フラットなウィンドウにする(枠無し) '戻値:0=失敗 0<>成功 変更前のウィンドウスタイルの値 Function kStyleCaption(ByVal uf As Object, Optional ByVal flat As Boolean) Dim wnd, ih# ih = uf.InsideHeight WindowFromObject uf, wnd If flat Then SetWindowLong wnd, GWL_EXSTYLE, GetWindowLong(wnd, GWL_EXSTYLE) _ And Not WS_EX_DLGMODALFRAME kStyleCaption = SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) _ And Not WS_CAPTION) DrawMenuBar wnd uf.Height = uf.Height - uf.InsideHeight + ih End Function Private Sub UserForm_Activate() '実際にはイニシャル処理を記述 Application.Wait Now + TimeValue("0:00:05") 'サンプル5秒で閉じる Unload Me End Sub 'kStyleCaption関数の使用例 Private Sub UserForm_Initialize() kStyleCaption Me ', True End Sub