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