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