ModeLess UserForm Button

A

AsifShah

Board Regular
Joined
Feb 12, 2021
Messages
71
Office Version
  1. 2016
  2. 2013
Platform
  1. Windows
Hello Every One
Please help on below problem.
i want to add true or false Userform Modeless Button but i don't want to reopen my userform.
this code is working but its work on when i reopen my userform

Userform1.show VbModeLess


thanks in advance please help
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Do you mean toggling the ShowModal Property at runtime without closing and reopening the userform? If so, I am afraid, I don't think that's possible.

The closest thing I can think of is what our forum member ZVI came up with. See this post and this post
 
Upvote 0
Here is an enhanced version of the code:

File Demo:
ToggleUserFormShowModalProperty@RunTime.xlsm


1- Place the following code in a Standard Module:
VBA Code: 
Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, ByVal riid As LongPtr, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, ByVal riid As LongPtr, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
#End If

Public Sub Show_Form( _
    ByVal UserForm As MSForms.UserForm, _
    ByVal Modal As Boolean, _
    Optional ByVal FormAlreadyActivated As Boolean = False _
)
    Dim hwnd As LongPtr
    Call IUnknown_GetWindow(UserForm, VarPtr(hwnd))
    Set UserForm = HwndToDispatch(hwnd)
    With UserForm
        .Tag = IIf(FormAlreadyActivated, "Activated", "")
        .StartUpPosition = -(Not FormAlreadyActivated)
        .Hide
        .Show -Modal
    End With
End Sub

Private Function HwndToDispatch(ByVal hwnd As LongPtr) As MSForms.UserForm
    Const WM_GETOBJECT = &H3D&, OBJID_CLIENT = &HFFFFFFFC
    Const GW_CHILD = 5&, S_OK = 0&
    Const IID_IDISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Dim oDisp As MSForms.UserForm
    Dim hClient As LongPtr, lResult As Long
    Dim tGUID(0& To 3&) As Long
 
    hClient = GetNextWindow(hwnd, GW_CHILD)
    lResult = SendMessage(hClient, WM_GETOBJECT, NULL_PTR, ByVal OBJID_CLIENT)
    If lResult Then
        If IIDFromString(StrPtr(IID_IDISPATCH), VarPtr(tGUID(0&))) = S_OK Then
            If ObjectFromLresult(lResult, VarPtr(tGUID(0&)), NULL_PTR, oDisp) = S_OK Then
                If Not oDisp Is Nothing Then
                    Set HwndToDispatch = oDisp
                End If
            End If
        End If
    End If
End Function


2- Code in the UserForm Module:
VBA Code: 
Option Explicit

Private Sub UserForm_Activate()
' ================================================================='
'   Skip activate event when switching between Modal and Modeless. '
    If Me.Tag = "Activated" Then Me.Tag = "": Exit Sub             '
' ================================================================='

    'Existing Activate event code goes here ....
End Sub

Private Sub btn_ShowModal_Click()
  ' Modal
  Show_Form UserForm:=Me, Modal:=True, FormAlreadyActivated:=True
End Sub

Private Sub btn_ShowModeless_Click()
  ' Modeless
    Show_Form UserForm:=Me, Modal:=False, FormAlreadyActivated:=True
End Sub


3- Code Usage Examples in a Standard Module:

You will be calling the UserForm via the Show_Form SUB instead of using the native UserForm Show Method.

VBA Code: 
Option Explicit

Sub ShowForm_Modal()
  Show_Form UserForm:=UserForm1, Modal:=True, FormAlreadyActivated:=False
End Sub

Sub ShowForm_Modeless()
  Show_Form UserForm:=UserForm1, Modal:=False, FormAlreadyActivated:=False
End Sub
 
Last edited:
Upvote 0
Solution
Jaafar Tribak said:
Here is an enhanced version of the code:

File Demo:
ToggleUserFormShowModalProperty@RunTime.xlsm


1- Place the following code in a Standard Module:
VBA Code: 
Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, ByVal riid As LongPtr, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, ByVal riid As LongPtr, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
#End If

Public Sub Show_Form( _
    ByVal UserForm As MSForms.UserForm, _
    ByVal Modal As Boolean, _
    Optional ByVal FormAlreadyActivated As Boolean = False _
)
    Dim hwnd As LongPtr
    Call IUnknown_GetWindow(UserForm, VarPtr(hwnd))
    Set UserForm = HwndToDispatch(hwnd)
    With UserForm
        .Tag = IIf(FormAlreadyActivated, "Activated", "")
        .StartUpPosition = -(Not FormAlreadyActivated)
        .Hide
        .Show -Modal
    End With
End Sub

Private Function HwndToDispatch(ByVal hwnd As LongPtr) As MSForms.UserForm
    Const WM_GETOBJECT = &H3D&, OBJID_CLIENT = &HFFFFFFFC
    Const GW_CHILD = 5&, S_OK = 0&
    Const IID_IDISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Dim oDisp As MSForms.UserForm
    Dim hClient As LongPtr, lResult As Long
    Dim tGUID(0& To 3&) As Long
 
    hClient = GetNextWindow(hwnd, GW_CHILD)
    lResult = SendMessage(hClient, WM_GETOBJECT, NULL_PTR, ByVal OBJID_CLIENT)
    If lResult Then
        If IIDFromString(StrPtr(IID_IDISPATCH), VarPtr(tGUID(0&))) = S_OK Then
            If ObjectFromLresult(lResult, VarPtr(tGUID(0&)), NULL_PTR, oDisp) = S_OK Then
                If Not oDisp Is Nothing Then
                    Set HwndToDispatch = oDisp
                End If
            End If
        End If
    End If
End Function


2- Code in the UserForm Module:
VBA Code: 
Option Explicit

Private Sub UserForm_Activate()
' ================================================================='
'   Skip activate event when switching between Modal and Modeless. '
    If Me.Tag = "Activated" Then Me.Tag = "": Exit Sub             '
' ================================================================='

    'Existing Activate event code goes here ....
End Sub

Private Sub btn_ShowModal_Click()
  ' Modal
  Show_Form UserForm:=Me, Modal:=True, FormAlreadyActivated:=True
End Sub

Private Sub btn_ShowModeless_Click()
  ' Modeless
    Show_Form UserForm:=Me, Modal:=False, FormAlreadyActivated:=True
End Sub


3- Code Usage Examples in a Standard Module:

You will be calling the UserForm via the Show_Form SUB instead of using the native UserForm Show Method.

VBA Code: 
Option Explicit

Sub ShowForm_Modal()
  Show_Form UserForm:=UserForm1, Modal:=True, FormAlreadyActivated:=False
End Sub

Sub ShowForm_Modeless()
  Show_Form UserForm:=UserForm1, Modal:=False, FormAlreadyActivated:=False
End Sub
Click to expand...

Thanks alot my dear friend u solve my big problem :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Modeless UserForm appears on wrong Excel workbook
Replies
5
Views
219
Jaafar Tribak
Jaafar Tribak
S
  • Solved
Hide userform title bar, and locking the userform into a relative position on the application.
2
Replies
16
Views
715
Jaafar Tribak
Jaafar Tribak
S
  • Solved
UserForm vbModeless issue
Replies
1
Views
242
SQUIDD
S
B
  • Question Question
Opening userform
Replies
4
Views
179
RoryA
RoryA
S
  • Solved
CLose a Userfom After 10 Seconds or When User Clicks Button
Replies
3
Views
116
Jaafar Tribak
Jaafar Tribak

Forum statistics

Threads
1,224,798
Messages
6,181,038
Members
453,013
Latest member
Shubashish_Nandy

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top