ExcelVBA技 ユーザーフォーム E13U003

E13U003 (Excel2000~2013)
ユ-ザ-フォ-ムのウィンドウスタイルを変更する


ユーザーフォームのウィンドウスタイル(属性)を変更する kStyleMaxMin関数 を示します。
最大化最小化ボタンを付け 又 枠のドラッグによるサイズ変更を可能にします。

'フォーム モジュール
Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function WindowFromObject Lib "oleacc" Alias "WindowFromAccessibleObject" _
  (ByVal pacc As Object, phwnd As LongPtr) As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) 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
Private Declare Function WindowFromObject Lib "oleacc" Alias "WindowFromAccessibleObject" _
  (ByVal pacc As Object, phwnd As Long) As Long
#End If
Const WS_MAXIMIZEBOX = &H10000
Const WS_MINIMIZEBOX = &H20000
Const WS_THICKFRAME = &H40000 'サイズ変更
Const GWL_STYLE = (-16)

'kStyleMaxMin関数
'ユーザーフォームに最大化最小化ボタンを付けサイズ変更可能にする
Sub kStyleMaxMin(uf As UserForm)
  Dim hwnd
  WindowFromObject uf, hwnd
  SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or WS_MAXIMIZEBOX Or _
    WS_MINIMIZEBOX Or WS_THICKFRAME
  DrawMenuBar hwnd
End Sub

'kStyleMaxMin関数の使用例
Private Sub UserForm_Initialize()
  kStyleMaxMin Me
End Sub

Private Sub UserForm_Resize() 'サイズ変更がされた
  If Height < InsideHeight Then Exit Sub '最小化された
  '各コントロールの位置やサイズを調整するコードを記述
  'Debug.Print Height; Width
End Sub