HOME > エクセルVBA > サンプル > UserForm

UserForm


【ファイル名】UserForm.xlsm
【バージョン】Ver 1.0.4.1
【作成日】2019年04月18日
【更新日】2021年06月13日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】UserForm.zip
【説明】[X]ボタンのないUserFormなどのサンプルです。
メニュー

【外部リンク】Windows > Apps > Win32 > API > Windows GDI > Wingdi.h >  CreateEllipticRgnDeleteObjectGetDeviceCaps
【外部リンク】Windows > Apps > Win32 > API > Windows GDI > Winuser.h >  GetDCReleaseDCSetWindowRgn
【外部リンク】Windows > Apps > Win32 > API > Keyboard and Mouse Input > Winuser.h >  ReleaseCapture
【外部リンク】Windows > Apps > Win32 > API > Menus and Other Resources > Winuser.h >  DeleteMenuDrawMenuBarGetSystemMenu
【外部リンク】Windows > Apps > Win32 > API > Windows Accessibility Features > Oleacc.h > WindowFromAccessibleObject
【外部リンク】Windows > Apps > Win32 > API > Windows and Messages > Winuser.h >  GetClassNameGetWindowLongPtrWEnumWindowsFindWindowExWSendMessageShowWindowSetLayeredWindowAttributesSetParentSetWindowLongPtrW


customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="ユーザー フォーム">
            <button id="DiisableCloseButtonForm" label="[?]ボタンを無視" keytip="D" supertip="[?]ボタンを実行しても無視して終了しません。" imageMso="HappyFace" onAction="onAction" />
            <button id="CancelButtonForm" label="[?]ボタンでキャンセル" keytip="C" supertip="[?]ボタンを実行すると、キャンセルボタンを実行します。" imageMso="HappyFace" onAction="onAction" />
            <button id="NoCloseButtonForm" label="[?]ボタンのない" keytip="X" supertip="タイトルバーの[?]ボタンのないフォームを表示します。" imageMso="HappyFace" onAction="onAction" />
            <separator id="separator1" />
            <button id="NoTitlebarForm" label="スプラッシュ ウィンドウ" keytip="S" supertip="スプラッシュ ウィンドウを表示します。" imageMso="HappyFace" onAction="onAction" />
            <button id="SizeForm" label="サイズを拡大縮小" keytip="I" supertip="サイズを拡大縮小できるフォームを表示します。" imageMso="HappyFace" onAction="onAction" />
            <button id="DragMoveForm" label="ドラッグして移動" keytip="M" supertip="タイトルバーのないフォームをマウスでドラッグして移動します。" imageMso="HappyFace" onAction="onAction" />
            <button id="NoMoveForm" label="移動しないフォーム" keytip="O" supertip="移動しないフォームです。" imageMso="HappyFace" onAction="onAction" />
            <separator id="separator2" />
            <button id="AlphaForm" label="半透明" keytip="A" supertip="半透明のフォームを表示します。" imageMso="HappyFace" onAction="onAction" />
            <button id="EllipticForm" label="楕円形" keytip="E" supertip="楕円形のフォームを表示します。" imageMso="HappyFace" onAction="onAction" />
            <separator id="separator3" />
            <button id="StayOnTopForm" label="常に手前に表示" keytip="T" supertip="フォームを常に手前に表示します。" imageMso="HappyFace" onAction="onAction" />
            <button id="BackForm" label="常に背面に表示" keytip="B" supertip="フォームを常に背面に表示します。クリックしても前面になりません。" imageMso="HappyFace" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

RibbonModule

Option Explicit
Option Private Module

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  Select Case control.ID
    Case "DiisableCloseButtonForm" ' [X]ボタンを無効にする
      DiisableCloseButtonForm.Show vbModal
    Case "CancelButtonForm" ' [X]ボタンをクリックしたら「キャンセル」ボタンを実行する
      CancelButtonForm.Show vbModal
    Case "DragMoveForm" ' ドラッグ&ドロップでウィンドウを移動する
      DragMoveForm.Show vbModal
    Case "NoCloseButtonForm" ' [X]ボタンがないウィンドウ
      NoCloseButtonForm.Show vbModal
    Case "NoTitlebarForm" ' タイトルバーのないウィンドウ
      NoTitlebarForm.Show vbModal
    Case "SizeForm" ' サイズを拡大縮小できるウィンドウ
      SizeForm.Show vbModal
    Case "AlphaForm" ' 半透明のフォームを表示
      AlphaForm.Show vbModal
    Case "EllipticForm" ' 楕円形のフォームを表示
      EllipticForm.Show vbModal
    Case "StayOnTopForm" ' 常に手前に表示する
      StayOnTopForm.Show vbModeless
    Case "BackForm" ' 常に背面に表示する
      BackForm.Show vbModeless
    Case "NoMoveForm" ' 移動しないフォーム
      NoMoveForm.Show vbModeless
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical, Title:="エラー"
      Exit Sub
  End Select
  Exit Sub
'-------------------------------------------------------------------------------------------------------------------------
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical, Title:="エラー"
End Sub
このページの上

OtherModule

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
  Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As LongPtr, ByVal lpsz2 As LongPtr) As LongPtr
  Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As LongPtr, ByVal lpClassName As LongPtr, ByVal nMaxCount As Long) As Long
#Else
  Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, lPalam As Long) As Long
  Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As Long, ByVal lpsz2 As Long) As Long
  Private Declare Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
#End If

Private Const MAX_PATH = 260

#If Win64 Then
  Private DesktopHWnd As LongPtr
#Else
  Private DesktopHWnd As Long
#End If

#If Win64 Then
Public Function GetDesktopHandle() As LongPtr
#Else
Public Function GetDesktopHandle() As Long
#End If
  EnumWindows AddressOf EnumWindowsProc, 0 ' AddressOfは標準モジュールでなくてはいけません。
  GetDesktopHandle = DesktopHWnd
End Function

#If Win64 Then
  Public Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
#Else
  Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If

  If IsDesktopWindow(hWnd) Then
    DesktopHWnd = hWnd
    EnumWindowsProc = False
  Else
    EnumWindowsProc = 1
  End If
End Function

' 指定したヌルで終わる文字列から、vbNullCharの左側の文字列を取得します。
Public Function StrVBA(ByVal EndNullString As String) As String
  Dim p As Long
  
  p = InStr(1, EndNullString, vbNullChar)
  If p > 0 Then
    StrVBA = Left(EndNullString, p - 1)
  Else
    StrVBA = EndNullString ' ■ vbNullCharがない場合は引数をそのまま返します。
'    StrVBA = vbNullString ' ■ 必要に応じて変更してください。
  End If
End Function

' デスクトップ ウィンドウか? 【注意】Windows7からAeroが有効の場合は、今までの方法では取得できません。
#If Win64 Then
  Private Function IsDesktopWindow(ByVal hWnd As LongPtr) As Boolean
  Dim ChildWin As LongPtr
#Else
  Private Function IsDesktopWindow(ByVal hWnd As Long) As Boolean
  Dim ChildWin As Long
#End If
  Dim ClassName As String
  
  IsDesktopWindow = False
  ClassName = String(MAX_PATH, vbNullChar)
  GetClassName hWnd, StrPtr(ClassName), MAX_PATH ' ウィンドウのハンドルからクラス名を取得する
  ClassName = StrVBA(ClassName) ' ヌルで終わる文字列から、vbNullCharの左側の文字列を取得します。
  If InStr(1, ClassName, "Progman", vbTextCompare) > 0 Or ClassName Like "*Progman*" Or ClassName Like "*WorkerW*" Then ' クラス名がProgramか*Progman*か*WorkerW*の場合は、
    ChildWin = FindWindowEx(hWnd, 0, StrPtr("SHELLDLL_DefView"), StrPtr(vbNullString)) ' 子のウィンドウがSHELLDLL_DefViewなら、デスクトップ ウィンドウ
    If ChildWin Then
      IsDesktopWindow = True
    End If
  End If
End Function
このページの上

EllipticForm 楕円のフォーム

Option Explicit

#If Win64 Then
  ' https://docs.microsoft.com/ja-jp/windows/desktop/api/wingdi/nf-wingdi-createellipticrgn
  Private Declare PtrSafe Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPtr

  ' https://docs.microsoft.com/ja-jp/windows/desktop/api/wingdi/nf-wingdi-deleteobject
  Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
  
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getdc
  Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

  ' https://docs.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getdevicecaps
  Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-releasedc
  Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long

  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-setwindowrgn
  Private Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hWnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
  
  ' https://docs.microsoft.com/ja-jp/windows/desktop/api/oleacc/nf-oleacc-windowfromaccessibleobject
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As LongPtr) As Long
#Else
  Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
  Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
  Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As Long) As Long
#End If

Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X
Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y

#If Win64 Then
  Private myHwnd As LongPtr
  Dim hDC As LongPtr
#Else
  Private myHwnd As Long
  Dim hDC As Long
#End If

Private Property Get hWnd()
  WindowFromAccessibleObject Me, myHwnd ' フォームのハンドルを取得する
  hWnd = myHwnd
End Property

Private Sub CloseButton_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Private Sub UserForm_Initialize() ' 初期化
#If Win64 Then
  Dim Rgn As LongPtr
#Else
  Dim Rgn As Long
#End If
  Dim XPixelsPerInch As Long
  Dim YPixelsPerInch As Long

  hDC = GetDC(hWnd)
  XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
  YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
  ReleaseDC hWnd, hDC
  Rgn = CreateEllipticRgn(0, 0, Me.Width * XPixelsPerInch / 72, Me.Height * YPixelsPerInch / 72) ' ポイントからピクセルに変換
  If Rgn <> 0 Then
    Call SetWindowRgn(hWnd, Rgn, True)
    Call DeleteObject(Rgn)
  End If
End Sub
このページの上

AlphaForm 半透明のフォーム

Option Explicit

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-getwindowlongw
  Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-setlayeredwindowattributes
  Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As LongPtr, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-setwindowlongw
  Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  
  ' https://docs.microsoft.com/ja-jp/windows/desktop/api/oleacc/nf-oleacc-windowfromaccessibleobject
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As LongPtr) As Long
#Else
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As Long) As Long
#End If
  
Private Const GWL_EXSTYLE As Long = &HFFEC 'Windowの拡張スタイルを取得
Private Const LWA_ALPHA  As Long = &H2 'Windowを半透明にする
Private Const WS_EX_LAYERED As Long = &H80000 'レイヤーのWindow

#If Win64 Then
  Private myHwnd As LongPtr
#Else
  Private myHwnd As Long
#End If

Private Property Get hWnd()
  WindowFromAccessibleObject Me, myHwnd ' フォームのハンドルを取得する
  hWnd = myHwnd
End Property

Private Sub ScrollBar1_Change()
  ScrollBar1.ControlTipText = ScrollBar1.Value
  Call SetLayeredWindowAttributes(hWnd, 0, ScrollBar1.Value, LWA_ALPHA) ' 第3引数の0は透明、255は不透明
End Sub

Private Sub UserForm_Initialize()
  Dim Wstyle As Long
  
  ScrollBar1.Min = 128   ' 【注意】0にすると透明で見えなくなる
  ScrollBar1.Max = 255   ' 不透明
  ScrollBar1.Value = 128 ' 半透明
  
  Wstyle = GetWindowLong(hWnd, GWL_EXSTYLE)
  Call SetWindowLong(hWnd, GWL_EXSTYLE, Wstyle Or WS_EX_LAYERED)
  Call SetLayeredWindowAttributes(hWnd, 0, ScrollBar1.Value, LWA_ALPHA) ' 第3引数の0は透明、255は不透明
End Sub
このページの上

BackForm 常に背面に表示するフォーム

【注意】OSのバージョンや環境により動作しません。
Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As LongPtr) As Long
#Else
  Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As Long) As Long
#End If

Private Sub CloseBtn_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Private Sub UserForm_Initialize() ' フォームの初期処理
#If Win64 Then
  Dim hWnd As LongPtr
  Dim hParent As LongPtr
#Else
  Dim hWnd As Long
  Dim hParent As Long
#End If

  WindowFromAccessibleObject Me, hWnd ' フォームのハンドルを取得する
  hParent = GetDesktopHandle
  If hParent = 0 Then ' 見つからない
    MsgBox Prompt:="このWindowsでは実行できません!", Buttons:=vbCritical, Title:="エラー"
  Else
    SetParent hWnd, hParent ' デスクトップのウィンドウを親にする
  End If
End Sub
このページの上

CancelButtonForm [X]ボタンをクリックすると、[キャンセル]ボタンを実行するフォーム

Option Explicit

Private Sub OkBtn_Click() ' 「OK」ボタン
  MsgBox Prompt:="OK", Buttons:=vbInformation, Title:="情報"
End Sub

Private Sub CancelBtn_Click() ' 「キャンセル」ボタン
  MsgBox Prompt:="「キャンセル」ボタンの処理です。", Buttons:=vbInformation, Title:="情報"
  Unload Me
End Sub

Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) ' フォームを閉じる前のイベント
  If CloseMode <> vbFormCode Then CancelBtn.Value = True ' コードから終了しないで[×]をクリックした場合は、「キャンセル」ボタンを実行する
End Sub
このページの上

DiisableCloseButtonForm [X]ボタンを無視するフォーム

Option Explicit

Private Sub ExitBtn_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) ' フォームを閉じる前のイベント
  Cancel = CInt(CloseMode = vbFormControlMenu) ' [×]をクリックした場合は終了しない
End Sub
このページの上

DragMoveForm ドラッグして移動するフォーム

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
  Private Declare PtrSafe Function ReleaseCapture Lib "user32" () As Long
  Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
' 【注意】Office64ビットではGetWindowLong, SetWindowLong, GetClassLong, SetClassLongではなく、
'              GetWindowLongPtr ,SetWindowLongPtr, GetClassLongPtr, SetClassLongPtrを推奨してます。SetWindowLongPtrWを使用した方が良いです。
  Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As LongPtr) As Long
#Else
  Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  Private Declare Sub ReleaseCapture Lib "User32.dll" ()
  Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As Long) As Long
#End If

Const GWL_STYLE = -16& ' 拡張ウインドウ スタイル
Const GWL_EXSTYLE = -20& ' 拡張ウインドウ スタイル
Const HTCAPTION = 2& ' タイトル バー領域
Const WM_NCLBUTTONDOWN = &HA1& ' ウィンドウの非クライアント領域内にマウスの左ボタンを押した
Const WS_CAPTION = &HC00000 ' タイトル バーを持つウィンドウ
Const WS_EX_DLGMODALFRAME = &H1& ' 二重境界を持つウィンドウ

Private Sub ExitBtn_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Sub UserForm_Initialize() ' フォームの初期処理
  Dim iHeight As Single ' フォームの中のクライアント領域の高さ
#If Win64 Then
  Dim hWnd As LongPtr
#Else
  Dim hWnd As Long
#End If
  
  iHeight = Me.InsideHeight ' クライアント領域の高さ
  WindowFromAccessibleObject Me, hWnd ' フォームのハンドルを取得する
  SetWindowLong hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME ' ウィンドウの拡張スタイルを変更する
  SetWindowLong hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) And Not WS_CAPTION ' ウィンドウのスタイルを変更する
  DrawMenuBar hWnd ' メニュー バーを再描画する
  Me.Height = Me.Height - Me.InsideHeight + iHeight ' タイトルバーの高さを除いた高さにする
End Sub
 
Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) ' フォームのマウスダウンのイベント
#If Win64 Then
  Dim hWnd As LongPtr
#Else
  Dim hWnd As Long
#End If

  If Button = xlPrimaryButton Then ' マウスの左ボタンを押している場合は、
    WindowFromAccessibleObject Me, hWnd ' フォームのハンドルを取得する
    ReleaseCapture ' マウス キャプチャを解放する
    SendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& ' 押されたのがタイトルバーだと騙して移動する
  End If
End Sub

NoMoveForm [移動しないフォーム

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function DeleteMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr
  Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, ByVal bRevert As Long) As LongPtr
#Else
  Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
  Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
#End If

Const SC_MOVE = &HF010& ' 移動
Const MF_BYCOMMAND = &H0& ' メニュー項目識別子を指定する

Sub UserForm_Initialize() ' フォームの初期処理
#If Win64 Then
  Dim hWnd As LongPtr
  Dim hMenu As LongPtr
  Dim hLong As LongPtr
#Else
  Dim hWnd As Long
  Dim hMenu As Long
  Dim hLong As Long
#End If

  hWnd = FindWindow(StrPtr(vbNullString), StrPtr(Caption)) ' タイトルバーのタイトルから、ウィンドウのハンドルを取得する
  hMenu = GetSystemMenu(hWnd, 0&) ' システムメニューのハンドルを取得する
  DeleteMenu hMenu, SC_MOVE, MF_BYCOMMAND ' 移動メニューを削除する
  DrawMenuBar hWnd ' [移動]を削除したメニューを描画する
End Sub

NoCloseButtonForm [X]ボタンのないフォーム

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function DeleteMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr
  Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, ByVal bRevert As Long) As LongPtr
' 【注意】Office64ビットではGetWindowLong, SetWindowLong, GetClassLong, SetClassLongではなく、
'              GetWindowLongPtr ,SetWindowLongPtr, GetClassLongPtr, SetClassLongPtrを推奨してます。GetWindowLongPtrWをGetWindowLongの名前で使用してます。
  Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
  Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
  Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
  Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If

Const GWL_STYLE = -16& ' ウィンドウスタイルを取得する
Const WS_SYSMENU = &H80000 ' タイトルバーにコントロールメニューボックスを持つウィンドウ
Const SC_CLOSE = &HF060& ' 閉じる
Const MF_BYCOMMAND = &H0& ' メニュー項目識別子を指定する

Private Sub ExitBtn_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Sub UserForm_Initialize() ' フォームの初期処理
#If Win64 Then
  Dim hWnd As LongPtr
  Dim hMenu As LongPtr
  Dim hLong As LongPtr
#Else
  Dim hWnd As Long
  Dim hMenu As Long
  Dim hLong As Long
#End If

  hWnd = FindWindow(StrPtr(vbNullString), StrPtr(Caption)) ' タイトルバーのタイトルから、ウィンドウのハンドルを取得する
  hMenu = GetSystemMenu(hWnd, 0&) ' システムメニューのハンドルを取得する
  DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND ' システムメニューを削除する

  hLong = GetWindowLong(hWnd, GWL_STYLE) And (Not WS_SYSMENU) ' システムメニューのないウィンドウのスタイル
  SetWindowLong hWnd, GWL_STYLE, hLong ' ウィンドウのスタイルを変更する
  DrawMenuBar hWnd ' 「X」ボタンを削除する
End Sub

NoTitlebarForm タイトルバーのないフォーム

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
  Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As LongPtr) As Long
#Else
  Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As Long) As Long
#End If

Const GWL_STYLE = (-16&) ' ウィンドウ スタイル
Const WS_CAPTION = &HC00000 ' タイトル バーを持つウィンドウ

Sub UserForm_Activate() ' フォームのアクティブのイベント
  Application.Wait Now + TimeSerial(0, 0, 3) ' 3秒間待つ
  Unload Me ' 自動でフォームを閉じる
End Sub

Sub UserForm_Initialize() ' フォームの初期処理
  Dim iHeight As Single ' フォームの中のクライアント領域の高さを
#If Win64 Then
  Dim hWnd As LongPtr
#Else
  Dim hWnd As Long
#End If
  
  iHeight = Me.InsideHeight ' フォームの内側の高さ
  WindowFromAccessibleObject Me, hWnd ' フォームのハンドルを取得する
  SetWindowLong hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) And Not WS_CAPTION ' スタイルを変更する
  DrawMenuBar hWnd ' ウィンドウを描画する
  Me.Height = Me.Height - Me.InsideHeight + iHeight ' タイトルバーの高さを除いた高さにする
End Sub

SizeForm サイズを拡大縮小するフォーム

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
  Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As LongPtr) As Long
#Else
  Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (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& ' スタイルの取得

Const SW_SHOWNORMAL = 1& ' 普通のサイズのウィンドウにする
Const SW_SHOWMINIMIZED = 2& ' ウィンドウを最小化
Const SW_SHOWMAXIMIZED = 3& ' ウィンドウを最大化

#If Win64 Then
  Private myHwnd As LongPtr
#Else
  Private myHwnd As Long
#End If

Private Property Get hWnd()
  WindowFromAccessibleObject Me, myHwnd ' フォームのハンドルを取得する
  hWnd = myHwnd
End Property

Private Sub CloseBtn_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Private Sub RestoreSizeBtn_Click() ' 元のサイズに戻す
  ShowWindow hWnd, SW_SHOWNORMAL
End Sub

Private Sub MinSizeBtn_Click() ' 最小化
  ShowWindow hWnd, SW_SHOWMINIMIZED
End Sub

Private Sub MaxSizeBtn_Click() ' 最大化
  ShowWindow hWnd, SW_SHOWMAXIMIZED
End Sub

Sub UserForm_Initialize() ' フォームの初期処理
  SetWindowLong hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_THICKFRAME
  DrawMenuBar hWnd
End Sub

Private Sub UserForm_Resize() ' フォームのサイズ変更のイベント
  SizeLabel.Caption = "ウィンドウのサイズは幅が" & Me.Width & "、高さが" & Me.Height & "です。"
End Sub

StayOnTopForm 常に手前に表示するフォーム

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As LongPtr) As LongPtr
#Else
  Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal pacc As Object, phwnd As Long) As Long
#End If

Private Const HWND_TOPMOST = -1& ' 常に手前に表示
Private Const SWP_NOSIZE = &H1 ' サイズ変更しない
Private Const SWP_NOMOVE = &H2 ' 移動しない
Private Const SWP_SHOWWINDOW = &H40 ' ウィンドウの表示

Private Sub ExitBtn_Click() ' 「閉じる」ボタン
  Unload Me
End Sub

Private Sub UserForm_Initialize() ' フォームの初期処理
#If Win64 Then
  Dim hWnd As LongPtr
#Else
  Dim hWnd As Long
#End If
  
  WindowFromAccessibleObject Me, hWnd ' フォームのハンドルを取得する
  SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOSIZE Or SWP_NOMOVE ' ウィンドウを常に手前にする
End Sub