模拟从右到左的显示，如下所示MsgBox
有必要使用一些API*) 获得所需布局的函数独立的默认情况下，从使用从右到左功能的语言设置。
- 识别用户表单handle访问更多 API 方法
-
Remove用户表单的标题栏
- 更换它例如使用显示标题的标签控件并为其提供拖动功能来移动用户窗体（此处：
Label1).
-
使用另一个控件（此处：Label2）来模拟系统转义“x”。
*) API——应用程序编程接口
一个简单的用户窗体代码示例
您所需要的只是提供 2 个标签控件，其中Label1替换标题栏并接收用户窗体的标题和Label2模拟系统转义“x”。此外，这个例子使用了Type方便处理用户表单的声明handle对于需要它来执行进一步 API 操作的多个事件过程。
► 截至 2018 年 10 月 22 日的第二次编辑注意事项
由于窗口句柄被声明为LongPtr在 Office 2010 或更高版本中以及Long在之前的版本中，需要通过条件编译常量来区分不同版本（例如#If VBA7 Then ... #Else ... #End If;参见第二节。还使用Win64常数来识别actually安装的 64 位 Office 系统 - 请注意，Office 通常默认安装为 32 位）。
Option Explicit ' declaration head of userform code module
#If VBA7 Then ' compile constant for Office 2010 and higher
Private Type TThis ' Type declaratation
frmHandle As LongPtr ' receives form window handle 64bit to identify this userform
End Type
#Else ' older versions
Private Type TThis ' Type declaratation
frmHandle As Long ' receives form window handle 32bit to identify this userform
End Type
#End If
Dim this As TThis ' this - used by all procedures within this module
Private Sub UserForm_Initialize()
' ~~~~~~~~~~~~~~~~~~~~~~~
' [1] get Form Handle
' ~~~~~~~~~~~~~~~~~~~~~~~
this.frmHandle = Identify(Me) ' get UserForm handle via API call (Long)
' ~~~~~~~~~~~~~~~~~~~~~~~
' [2] remove System Title Bar
' ~~~~~~~~~~~~~~~~~~~~~~~
HideTitleBar (this.frmHandle) ' hide title bar via API call
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Purpose: Replaces System Title Bar (after removal via API) and receives dragging functionality
' ~~~~~~~~~~~~~~~~~~~~~~~~~~
' [3] allow to move UserForm
' ~~~~~~~~~~~~~~~~~~~~~~~~~~
If Button = 1 Then DragForm this.frmHandle
End Sub
Private Sub Label2_Click()
' Purpose: Label "x" replaces System Escape (after removal in step [2])and hides UserForm
' ~~~~~~~~~~~~~~~~~
' [4] hide UserForm
' ~~~~~~~~~~~~~~~~~
Me.Hide
End Sub
Private Sub UserForm_Layout()
Me.RightToLeft = True
' Simulated Escape Icon
Me.Label2.Caption = " x"
Me.Label2.BackColor = vbWhite
Me.Label2.Top = 0
Me.Label2.Left = 0
Me.Label2.Width = 18: Me.Label2.Height = 18
' Simulated UserForm Caption
Me.Label1.Caption = Me.Caption
Me.Label1.TextAlign = fmTextAlignRight ' <~~ assign right to left property
Me.Label1.BackColor = vbWhite
Me.Label1.Top = 0: Me.Label1.Left = Me.Label2.Width: Me.Label1.Height = Me.Label2.Height
Me.Label1.Width = Me.Width - Me.Label2.Width - 4
End Sub
二. API 函数的单独代码模块
a) 带有常量和特殊 API 声明的声明头
有必要提供不同的应用程序版本，因为某些参数的代码声明有所不同（例如 PtrSafe）。 64 位声明开始如下：Private Declare PtrSafe ...
还要注意通过以下方式进行正确的声明#If, #Else and #End If允许版本相关的编译。
前缀&H常量中使用的 代表十六进制值。
Option Explicit
Private Const WM_NCLBUTTONDOWN = &HA1&
Private Const HTCAPTION = 2&
Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_CAPTION = WS_BORDER Or WS_DLGFRAME
#If VBA7 Then ' True if you're using Office 2010 or higher
' [0] ReleaseCapture
Private Declare PtrSafe Sub ReleaseCapture Lib "User32" ()
' [1] SendMessage
Private Declare PtrSafe Function SendMessage Lib "User32" _
Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr ' << arg's hWnd, wParam + function type: LongPtr
' [2] FindWindow
Private Declare PtrSafe Function FindWindow Lib "User32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr ' << function type: LongPtr
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Two API functions requiring the Win64 compile constant for 64bit Office installations
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#If Win64 Then ' true if Office explicitly installed as 64bit
' [3a] Note that GetWindowLong has been replaced by GetWindowLongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "User32" _
Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
' [3b] Note that GetWindowLong has been replaced by GetWindowLongPtr
' Changes an attribute of the specified window.
' The function also sets a value at the specified offset in the extra window memory.
Private Declare PtrSafe Function SetWindowLongPtr Lib "User32" _
Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
#Else ' true if Office install defaults 32bit
' [3aa] Note that GetWindowLong has been replaced by GetWindowLongPtr Alias GetWindowLongA !
Private Declare PtrSafe Function GetWindowLongPtr Lib "User32" _
Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
' [3bb] Note that GetWindowLong has been replaced by GetWindowLongPtr Alias SetWindowLongA !
Private Declare PtrSafe Function SetWindowLongPtr Lib "User32" _
Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
#End If
' [4] DrawMenuBar
Private Declare PtrSafe Function DrawMenuBar Lib "User32" _
(ByVal hWnd As LongPtr) As Long ' << arg hWnd: LongPtr
#Else ' True if you're using Office before 2010 ('97)
Private Declare Sub ReleaseCapture Lib "User32" ()
Private Declare 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 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
#End If
b) 以下程序（a 节之后）
' ~~~~~~~~~~~~~~~~~~~~~~
' 3 Procedures using API
' ~~~~~~~~~~~~~~~~~~~~~~
#If VBA7 Then ' Office 2010 and higher
Public Function Identify(frm As Object) As LongPtr
' Purpose: [1] return window handle of form
' Note: vbNullString instead of ThunderXFrame (97) and class names of later versions
Identify = FindWindow(vbNullString, frm.Caption)
End Function
Public Sub HideTitleBar(hWnd As LongPtr)
' Purpose: [2] remove Userform title bar
SetWindowLongPtr hWnd, GWL_STYLE, GetWindowLongPtr(hWnd, GWL_STYLE) And Not WS_CAPTION
End Sub
Public Sub ShowTitleBar(hWnd As LongPtr)
' Purpose: show Userform title bar
SetWindowLongPtr hWnd, GWL_STYLE, GetWindowLongPtr(hWnd, GWL_STYLE) Or WS_CAPTION
End Sub
Public Sub DragForm(hWnd As LongPtr)
' Purpose: [3] allow to drag & move userform via control (here via e.g.: Label1)
Call ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
#Else ' vers. before Office 2010 (Office '97)
Public Function Identify(frm As Object) As Long
' Purpose: [1] return window handle of form
' Note: vbNullString instead of ThunderXFrame (97) and class names of later versions
Identify = FindWindow(vbNullString, frm.Caption)
End Function
Public Sub HideTitleBar(hWnd As Long)
' Purpose: [2] remove Userform title bar
SetWindowLong hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) And Not WS_CAPTION
End Sub
' Public Sub ShowTitleBar(HWND As Long)
' ' Purpose: show Userform title bar
' SetWindowLong HWND, GWL_STYLE, GetWindowLong(HWND, GWL_STYLE) Or WS_CAPTION
' End Sub
Public Sub DragForm(hWnd As Long)
' Purpose: [3] allow to drag & move userform via control (here via e.g.: Label1)
Call ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
#End If
► 注意事项： API 声明未经测试actually在 Office 2010 或更高版本中安装了 64 位系统。 The 第二次编辑截至 2018 年 10 月 22 日试图纠正几个LongPtr声明（仅适用于指向 → 句柄或 → 内存位置的指针）并使用当前的 Get/SetWindowLongPtr 函数显式区分Win64 and Win32;参见还编辑过TypeUserForm 代码模块的声明头中的声明）。
也可以看看Office 2010 32 位和 64 位版本之间的兼容性 http://msdn.microsoft.com/en-us/library/ee691831(office.14).aspx and Office 2010 帮助文件：具有 64 位支持的 Win32API PtrSafe http://www.microsoft.com/en-us/download/confirmation.aspx?id=9970
附加说明
用户窗体是Windows，可以通过它们的窗口来识别handle。
用于此目的的 API 函数是FindWindow处理两个参数：
1) 一个字符串，给出需要查找的窗口类的名称；2) 一个字符串，给出caption它需要找到的窗口（用户窗体）的名称。
因此，人们经常区分版本 '97（UserForm 类名称“ThunderXFrame”）和更高版本（“ThunderDFrame”）：
If Val(Application.Version) < 9 Then
hWnd = FindWindow("ThunderXFrame", frm.Caption) ' if used within Form: Me.Caption
Else ' later versions
hWnd = FindWindow("ThunderDFrame", frm.Caption) ' if used within Form: Me.Caption
End If
然而使用vbNullString (and独特的标题！）反而使编码变得更加容易：
hWnd = FindWindow(vbNullString, frm.Caption) ' if used within Form: Me.Caption
推荐进一步阅读
UserForm 代码模块实际上是classes并且应该这样使用。所以我建议阅读 M. Guindon 的文章用户表单1.显示 https://rubberduckvba.wordpress.com/2017/10/25/userform1-show/。 - 可能也有一些兴趣正确销毁无模式 UserForm 实例 https://stackoverflow.com/questions/47357708/vba-destroy-a-modeless-userform-instance-properly
