ModeLess UserForm Button

A

AsifShah

Board Regular
Joined
Feb 12, 2021
Messages
70
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

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
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

H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
321
huiettcm
H
M
  • Solved
Modeless userform disappears when a modal userform closes
Replies
4
Views
858
mcomp72
M
S
  • Question
UserForm onActivate does not fire
Replies
8
Views
665
Jaafar Tribak
Jaafar Tribak
K
  • Question
Run a vba Sub routine every xx seconds
Replies
1
Views
62
jkpieterse
jkpieterse
T
  • Question
UserForm Close Event Hangs
Replies
0
Views
170
trough
T

Forum statistics

Threads
1,215,260
Messages
6,123,926
Members
449,135
Latest member
NickWBA

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