【VBA】ユーザーフォームのタイトルバーを非表示にしてシステムっぽい見た目にする
記事更新日:2022-11-02
タイトルバーを消したい
タイトルバーを非表示にする設定
1.標準モジュールに記述
Option Private Module
Option Explicit
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Sub ReleaseCapture Lib "User32.dll" ()
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" _
(ByVal IAcessible As Object, ByRef hWnd As Long) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Const GWL_STYLE = (-16&)
Const GWL_EXSTYLE = (-20&)
Const WS_CAPTION = &HC00000
Const WS_EX_DLGMODALFRAME = &H1&
'kFormNonCaption関数
'ユーザーフォームのタイトルバー非表示
'引数:uf ユーザーフォーム
' flat True=フラットなウィンドウにする(枠無し)
'戻値:0=失敗 0<>成功 変更前のウィンドウスタイルの値
Function kFormNonCaption(ByVal uf As Object, Optional ByVal flat As Boolean) As Long
Dim wnd As Long, ih#
ih = uf.InsideHeight
WindowFromAccessibleObject uf, wnd
If flat Then SetWindowLong wnd, GWL_EXSTYLE, GetWindowLong(wnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
kFormNonCaption = SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) And Not WS_CAPTION)
DrawMenuBar wnd
uf.Height = uf.Height - uf.InsideHeight + ih
End Function
'FormDrag関数
'ユーザーフォームのタイトルバー以外でドラッグ可能にする
'引数:uf ユーザーフォーム
' Button MouseMoveイベントのButtonをそのまま渡す
'UserForm や Label などのMouseMoveイベント内から呼び出す
Public Sub FormDrag(ByVal uf As UserForm, ByVal Button As Integer)
Dim hWnd As Long
If Button = 1 Then
WindowFromAccessibleObject uf, hWnd
ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
「Private Declare PtrSafe」のPtrSafeがないとエラーになることがあります
2.フォームモジュールに記述
Option Private Module
Option Explicit
Private Sub UserForm_Initialize()
kFormNonCaption Me, True
End Sub
'ユーザーフォームをつかめるようにする
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
FormDrag Me, Button
End Sub
'ユーザーフォームにheaderを設置した場合、headerをつかめるようにする
Private Sub header_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
FormDrag Me, Button
End Sub
'-- 以下、必要な事項を記述 --
タイトルバーがなければ、好きなデザインにできる
×ボタンも消えるから、閉じるボタンは自作
関連記事
2022-11-02
編集後記:
この記事の内容がベストではないかもしれません。