Right to left userforms in excel - VBA
Please Look at the code below and test it:
Private Sub CommandButton1_Click()
MsgBox "This window converted Right to Left!", vbMsgBoxRtlReading
End Sub
This code convert the message window from right to left. As the close button moves to the left of the window. How do I do this for userforms? (Hope T.M., Mathieu Guindon and ... does not say: "Your question is amiss. Please read the links ....")
Like the picture below (Of course photo is photoshop!):
Simulate Right To Left display as in MsgBox
It'll be necessary to use some API *) functions to get the wanted layout independant from language settings using right to left functionality by default.
- Identify the Userform's handle to get access to further API methods
- Remove the Userform's title bar
- Replace it e.g. with a Label control displaying the caption and give it drag functionality to move the UserForm (here:
Label1). Use another control (here:
Label2) to simulate the system escape "x".*) API - Application Programming Interface
A simple UserForm code example
All you need is to provide for 2 Label controls where Label1 replaces the title bar and receives the UserForm's caption and Label2 simulates the system Escape "x". Furthermore this example uses a Type declaration for easy disposal of the UserForm handle for several event procedures needing it for further API actions.
► Note to 2nd edit as of 10/22 2018
As a window handle is declared as LongPtr in Office 2010 or higher and as Long in versions before, it was necessary to differentiate between the different versions by conditional compile constants (e.g. #If VBA7 Then ... #Else ... #End If; cf. section II. using also the Win64 constant to identify actually installed 64bit Office systems - note that frequently Office is installed as 32bit by default).
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
II. Separate code module for API functions
a) Declaration head with constants and special API declarations
It's necessary to provide for different application versions as the code declarations differ in some arguments (e.g. PtrSafe). 64 bit declarations start as follows: Private Declare PtrSafe ...
Take also care of the correct declarations via #If, #Else and #End If allowing version dependant compilation.
The prefix &H used in constants stands for hexadecimal values.
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) Following Procedures (after section 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
► Caveat: API declarations not tested for actually installed 64 bit systems in Office 2010 or higher. The 2nd Edit as of 10/22 2018 tries to correct several LongPtr declarations (only for pointers to a → handle or → memory location) and using the current Get/SetWindowLongPtr function differentiating explicitly between Win64 and Win32; cf. also edited Type declaration in the UserForm code module's declaration head).
See also Compatibility between 32bit and 64bit Versions of Office 2010 and Office 2010 Help Files: Win32API PtrSafe with 64bit Support
Additional note
UserForms are Windows and can be identified by their window handle.
The API function used for this purpose is FindWindow disposing of two arguments:
1) A string giving the name of the class of the window it needs to find and 2) a string giving the caption of the window (UserForm) it needs to find.
Therefore frequently one distinguishes between version '97 (UserForm class name "ThunderXFrame") and later versions ("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
However using vbNullString (and unique captions!) instead makes coding much easier:
hWnd = FindWindow(vbNullString, frm.Caption) ' if used within Form: Me.Caption
Recommended further reading
UserForm code modules actually are classes and should be used as such. So I recommend reading M. Guindon's article UserForm1.Show. - Possibly of some interest, as well is Destroy a modeless UserForm instance properly
- Constrain a Specman list so it doesn't have identical values in consecutive elements
- How to type cast a list of uint to a list of vr_ahb_data in Specman?
- Static fields/methods in e
- What is the difference between deep_copy and gen keeping in Specman?
- Specman UVM: What is the difference between write_reg { .field == 2;}; and write_reg_fields?
- Does Specman support optional parameters to a method?
- Specman e: When colon equal sign ":=" should be used?
- Specman e: Is there a way to know how many values there is in an enumerated type?
- Specman e error: No match for file when using "for each line in file"
- How to run e file one by one? Not in parallel test
- Specman/e constraint (for each in) iteration
- Specman e: How driver's items queue can be locked from a sequence?
- Specman e: How to print variable's address?
- Specman e: "keep type .. is a" fails to refine the type of a field
- Specman soft select on variable, decimal vs. hexadecimal values
- Specman e: How to print a pointer to a struct?
- Specman e: Is there a way to print unit instance name?
- Specman e: simultaneous events error
- Specman e coverage: ignored values appear in the coverage statistics
- Specman e: How a sequence should be started when gen_and_start_main constrained to FALSE?
- Specman/e list of lists (multidimensional array)
- Does Specman e have struct constructor?
- Specman e: How the predefined sequence.item should be used?
- Specman e: define-as-computed macro error
- Specman e UVM: Why to inherit from uvm_* units?
- Specman e: A sequence drives its BFM also its MAIN was not defined in a test
- e HVL (IEEE 1647): expect expression fails unexpectedly
- Specman e subtyping: How to refer to FALSE value of conditional field in when/extend subtyping?
- e HVL (IEEE 1647): How to set 'X' value?
- Difference between declaring an event that is sensitive to a simple_port value and event_port