Macro: Open native dialog box in center of Excel

[centerdialog]

I am trying to make an Excel macro that opens the worksheet "Activate" dialog box (normally opened by right clicking on the navigation arrows in the bottom left of the workbook) in the center of the Excel workbook (must work for a multi-monitor set up).


The below code (from: https://www.mrexcel.com/forum/excel-questions/5268-macro-choose-worksheet-view-all-wor-3.html) is just about the most elegant way to open the "Activate" dialog box. I would like to amend this code so that the native dialog box will always open in the center of the Excel workbook no matter its size or which monitor Excel is running in. I do not want to make a Userform or Msgbox for this.


Unfortunately, I do not know how to code or where to begin with making this amendment. Would anyone be able to help or does anyone have any idea how this would be done? Thanks very much.



<code class="yklcuq-7 iRRQrr">x = ActiveWorkbook.Sheets.Count
If x > 16 Then
Application.CommandBars("Workbook Tabs").Controls("More Sheets...").Execute
Else
Application.CommandBars("Workbook Tabs").ShowPopup
End If</code>

 

[centerdialog]

Yes, this is still disruptive, as I use the command hundreds of times a day at the office, which is why I am trying not to settle here. Hope you can understand.

Yes, it is likely there will be more noticeable flicker using the right click method (move cursor, center dialog box, move cursor back vs. center dialog box/commandbar), but I think I will try this method, as it could prove to be a better solution because right clicking the arrow will always open the activate dialog box no matter how many worksheets the workbook has (no need for Commandbar). As far as the worksheets bar being visible, I never hide the bar and have never seen it hidden. This will not be an issue.

 

[Jaafar Tribak]

Yes, this is still disruptive, as I use the command hundreds of times a day at the office, which is why I am trying not to settle here. Hope you can understand.

Yes, it is likely there will be more noticeable flicker using the right click method (move cursor, center dialog box, move cursor back vs. center dialog box/commandbar), but I think I will try this method, as it could prove to be a better solution because right clicking the arrow will always open the activate dialog box no matter how many worksheets the workbook has (no need for Commandbar). As far as the worksheets bar being visible, I never hide the bar and have never seen it hidden. This will not be an issue.

Sorry for the late reply.

You have to bear in mind that sending a right-click at the workbooks tab arrow when thre are more that 16 worksheets will need a second left-click to the bottom of the popup ( the one at the bottom that reads : ("More Sheets ...") ... This makes it more difficult to code and more prone to sending the mouse clicks at the wrong locations specially if that bottom left part of excel is being obscured by another window.

I am writing some new code which should avoid the need to introduce a delay before bring up the dialog and still function propperly.

The fact that the excel built-in workboooks tab dialog is not a propper Windows Dialog makes handling it programmatically rather difficult but I am testing a MSAA approach which looks promising .

I'll post the code later.

 

[Jaafar Tribak]

Ok- I just got around to finishing the MSAA-based code.

The tabs dialog box should now propperly function when invoked via the shortcut keys ( CTRL+W ) or via any other venue without the need to introduce the small delay while still always being displayed at the center of the excel application window.

What I found most difficult to figure out was the dialog item currently with the keyboard and mouse focus .

Here is a workbook example

Code in a Standard Module: ( run the Center_Sheets_List_Dialog macro)

Option Explicit

Private Type GUID
    lData1 As Long
    iData2 As Integer
    iData3 As Integer
    iData4(0 To 7) As Byte
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then

    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function PtInRect Lib "user32" (lpRect As RECT, ByVal arg2 As LongPtr) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Private Declare PtrSafe Function PtInRect Lib "user32" (lpRect As RECT, ByVal arg1 As Long, ByVal arg2 As Long) As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function AccessibleChildren Lib "Oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetAncestor Lib "user32" (ByVal hwnd As LongPtr, ByVal gaFlags As Long) As LongPtr
    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 GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, ByVal lpRect As Long, ByVal bErase As Long) As Long
    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
    Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 

    Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal arg1 As Long, ByVal arg2 As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function AccessibleChildren Lib "Oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function GetAncestor Lib "user32" (ByVal hwnd As Long, ByVal gaFlags As Long) As Long
    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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
    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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
    Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
Private Const CHILDID_SELF = &H0&
Private Const OBJID_SELF = &H0&
Private Const NAVDIR_FIRSTCHILD = &H7&
Private Const NAVDIR_DOWN = &H2&
Private Const S_OK = &H0
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const WM_SETREDRAW = &HB
Private Const GA_PARENT = 1

Private lInitCurX As Long, lInitCurY As Long
Private lTempCurX As Long, lTempCurY As Long
Private sSelectedSheet As String


Public Sub Center_Sheets_List_Dialog()

    If ActiveWorkbook.Sheets.Count < 17 Then
        SetTimer Application.hwnd, Application.hwnd, 0, AddressOf SetListPos
        SendMessage GetAncestor(Application.hwnd, GA_PARENT), ByVal WM_SETREDRAW, ByVal 0, 0
        Application.CommandBars("Workbook Tabs").ShowPopup
    Else
    
        SetTimer Application.hwnd, 0, 0, AddressOf SetListPos
        Application.CommandBars("Workbook Tabs").Controls(16).Execute
        If Len(sSelectedSheet) Then Worksheets(sSelectedSheet).Activate
    End If
    
End Sub


[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Sub SetListPos(ByVal hwnd As LongPtr, ByVal MSG As Long, ByVal nIDEvent As LongPtr, ByVal dwTimer As Long)
    Dim hPopUp As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Sub SetListPos(ByVal hwnd As Long, ByVal MSG As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Dim hPopUp As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    
    '***************************
    Dim tRectApp As RECT, tRectPopUp As RECT
    Dim cxChild As Long, cyChild As Long, cxParent As Long, cyParent As Long
    Dim X As Long, Y As Long
    Dim sCaption As String, iLCID As Integer
    Dim oCtrl As IAccessible
    '*****************************************
    Dim tGUID(0 To 3) As Long
    Dim oIAcc As IAccessible
    Dim oIAccChild  As IAccessible
    Dim vFocus As Variant
    Dim vAcc As Variant
    Dim tCursPos As POINTAPI
    Dim tOKRect As RECT, tCancelRect As RECT, tListRect As RECT, tXbuttonRect As RECT
    Dim lLeft As Long, lTop As Long, lWidth As Long, lHeight As Long
    Dim bCancel As Boolean
    '*******************************************
        
    On Error Resume Next
    
    KillTimer hwnd, nIDEvent
    
    iLCID = Application.LanguageSettings.LanguageID(msoLanguageIDInstall)

    Select Case iLCID
        Case 1033, 3081, 10249, 4105, 6153, 8201, 5129, 7177, 11273, 2057
            sCaption = "Activate" [COLOR=#008000][B]'english[/B][/COLOR]
        Case 2060, 3084, 5132, 4108, 1036
            sCaption = "Activer" [COLOR=#008000][B]'french[/B][/COLOR]
        Case 1034, 11274, 16394, 13322, 9226, 5130, 7178, 12298, 4106, 18442, 2058, 19466, 6154, 10250, 20490, 15370, 17418, 8202
            sCaption = "Activar" [B][COLOR=#008000]'spanish[/COLOR][/B]
    End Select

    hPopUp = IIf(nIDEvent = hwnd, FindWindow("MsoCommandBarPopup", vbNullString), FindWindow("bosa_sdm_XL9", sCaption))

    [B][COLOR=#008000]'Set the position of the workbook tabs Commandbar Pop-Up or Dialog at the center of the excel window.[/COLOR][/B][B][COLOR=#008000]      '***************************************************************************************************[/COLOR][/B]
    If hPopUp Then

        GetWindowRect hwnd, tRectApp
        GetWindowRect hPopUp, tRectPopUp

        With tRectPopUp
            cxChild = .Right - .Left
            cyChild = .Bottom - .Top
        End With

        With tRectApp
            cxParent = .Right - .Left
            cyParent = .Bottom - .Top
        End With

        X = tRectApp.Left + (cxParent - cxChild) / 2
        Y = tRectApp.Top + (cyParent - cyChild) / 2

        If nIDEvent = hwnd Then
            ShowWindow hPopUp, 0
            SendMessage GetAncestor(hwnd, GA_PARENT), ByVal WM_SETREDRAW, ByVal 1&, 0&
            InvalidateRect 0, 0, 0
            For Each oCtrl In Application.CommandBars("Workbook Tabs").Controls
                If oCtrl.accState(CHILDID_SELF) = &H100010 Then
                    oCtrl.accSelect 1, CHILDID_SELF
                    Exit For
                End If
            Next
        End If

        SetWindowPos hPopUp, 0, X, Y, 0, 0, SWP_NOSIZE Or SWP_SHOWWINDOW + SWP_NOACTIVATE
    End If
    

   [B][COLOR=#008000] 'Handle special case when there are more than 16 sheets and the Workbooks tab Dialog is shown.
    '********************************************************************************************[/COLOR][/B]
    If FindWindow("bosa_sdm_XL9", sCaption) Then
    
        If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0))) = S_OK Then
        
            If AccessibleObjectFromWindow(hPopUp, OBJID_SELF, VarPtr(tGUID(0)), oIAcc) = S_OK Then
            
                Set vAcc = oIAcc
                
                Set oIAccChild = vAcc.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
                
                Set oIAccChild = oIAccChild.accNavigate(NAVDIR_DOWN, CHILDID_SELF)
                
                AccessibleChildren vAcc, 1, 1, vAcc, 1
                
                oIAccChild.accChild(4&).accLocation lLeft, lTop, lWidth, lHeight, CHILDID_SELF
                
                SetRect tListRect, lLeft, lTop, lWidth + lLeft, lHeight + lTop

                GetCursorPos tCursPos
                
                lInitCurX = tCursPos.X: lInitCurY = tCursPos.Y
                
                lTempCurX = lLeft + 40: lTempCurY = lTop + 40
                
               [COLOR=#008000][B] 'brively move the mouse pointer over the dialog and back... needed to trigger 'accHitTest' !![/B][/COLOR]
                SetTimer Application.hwnd, 0, 0, AddressOf MoveCursor
      
                Do While IsWindow(hPopUp)
                
                    [B][COLOR=#008000]'Store the dialog tabs List Rect.[/COLOR][/B]
                    Call oIAccChild.accChild(4&).accLocation(lLeft, lTop, lWidth, lHeight, CHILDID_SELF)
                    SetRect tListRect, lLeft, lTop, lWidth + lLeft, lHeight + lTop

                   [B][COLOR=#008000]'Store the dialog X-Close Menu Rect.[/COLOR][/B]
                    vAcc.accLocation lLeft, lTop, lWidth, lHeight, 5&
                    SetRect tXbuttonRect, lLeft, lTop, lLeft + lWidth, lTop + lHeight
        
                    GetCursorPos tCursPos
                    
                    If Err.Number = 0 And TypeName(vFocus.accFocus) <> "Empty" And _
                    TypeName(vFocus.accFocus) <> "IAccessible" Then
                        Set vFocus = oIAcc.accHitTest(tCursPos.X, tCursPos.Y)
                    End If
                    
                    If vFocus.accFocus = 1 Then [B][COLOR=#008000]'OK button has the focus.[/COLOR][/B]
                        sSelectedSheet = oIAccChild.accChild(4&).accValue
                        bCancel = False
                    ElseIf vFocus.accFocus = 2 Then [B][COLOR=#008000]'Cancel button has the focus.[/COLOR][/B]
                        bCancel = True
                    End If
                    
                    [B][COLOR=#008000]'Dialog closed via ESC key or ALT+F4.[/COLOR][/B]
                    If (GetAsyncKeyState(vbKeyEscape) <> 0) _
                    Or (GetAsyncKeyState(vbKeyF4) <> 0) Then
                        bCancel = True
                    End If
                    
                    [B][COLOR=#008000]'Dialog closed via the X-close menu.[/COLOR][/B]
                    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
                        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
                            Dim lngPtr As LongPtr
                            CopyMemory lngPtr, tCursPos, LenB(tCursPos)
                            If PtInRect(tXbuttonRect, lngPtr) _
                            And (GetAsyncKeyState(vbKeyLButton) <> 0) Then
                                bCancel = True
                            End If
                        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
                            If PtInRect(tXbuttonRect, tCursPos.X, tCursPos.Y) _
                            And (GetAsyncKeyState(vbKeyLButton) <> 0) Then
                                bCancel = True
                            End If
                        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
                    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
                        
                        If PtInRect(tXbuttonRect, tCursPos.X, tCursPos.Y) _
                        And (GetAsyncKeyState(vbKeyLButton) <> 0) Then
                            bCancel = True
                        End If
                    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

                    DoEvents
                    
                Loop
                
            End If
            
        End If
        
    End If
    
Xit:
   
    SendMessage GetAncestor(hwnd, GA_PARENT), ByVal WM_SETREDRAW, ByVal 1&, CHILDID_SELF
    
    If bCancel Then sSelectedSheet = ""

End Sub


Private Sub RestoreCursorPos()
    KillTimer Application.hwnd, 0
    Call SetCursorPos(lInitCurX, lInitCurY)
End Sub


Private Sub MoveCursor()
    KillTimer Application.hwnd, 0
    Call SetCursorPos(lTempCurX, lTempCurY)
    SetTimer Application.hwnd, 0, 0, AddressOf RestoreCursorPos
End Sub

 

[centerdialog]

Jaafar, terribly sorry for the delayed response. Thanks for all of your help, that latest code works perfectly. Amazing.

1. Saving the below code in the ThisWorkbook file successfully assigned the shortcut to Ctrl + Shift + W, but removed the "+" to test Ctrl + W, and it doesn't seem to be functioning. Is this how I would reassign the key if I wanted to?

Private Sub Workbook_Open()
Application.OnKey "+^{W}", "Center_Sheets_List_Dialog"
End Sub

2. Would this code work for Windows 10?
3. Would this code work for Excel 2016?

 

[Jaafar Tribak]

Hi,

1- Application.OnKey "+^{W}", "Center_Sheets_List_Dialog" didn't work for me either that's why I used Ctrl W instead of Ctrl Shift W

I suggest you use Ctrl W without the Shift key or if you really need to include the Shift key use letters other than W like A or Q etc ... :

The code below worked for me :

[COLOR=#333333]Private Sub Workbook_Open()[/COLOR]
[COLOR=#333333]    Application.OnKey "+^{[/COLOR][COLOR=#0000ff][B]Q[/B][/COLOR][COLOR=#333333]}", "Center_Sheets_List_Dialog"[/COLOR]
[COLOR=#333333]End Sub[/COLOR]

2-3 - In theory, the code should work for any Windows edition/bitness as well as any excel edition/bitness.

Having said that, I only tested the code on Win10 64bit excel 2010 64 bit.

You should try the code yourself on other machines and see what happens.

 

[centerdialog]

1. Curiously, using the Application.OnKey method on Excel 2010 win7: +^W worked for me but not ^W. Excel 2016 win7 using Application.OnKey: no shortcut with "W" worked.

On both Excel 2010 and 2016, I can circumvent the shortcomings of the Application.OnKey by setting the shortcut in the Alt + F8 window, and then going to "Options" for the macro. This seems to have the same end result of the Application.OnKey, though Applicaiton.OnKey will allow one to use the "Alt" key via "%" whereas it does not seem possible with Alt + F8. Essentially, I can still successfully bind the macro to Ctrl + W, or Ctrl + Shift + W, or Ctrl + Shift + Alt + W.


2-3. Okay, thanks for the information. When I have my other computers at my disposal I will confirm and test further.


Thanks again for all of your patience and help. This has been incredibly helpful and hopefully others can find some value in it.

 

[Jaafar Tribak]

2-3. Okay, thanks for the information. When I have my other computers at my disposal I will confirm and test further.

Thanks again for all of your patience and help. This has been incredibly helpful and hopefully others can find some value in it.

I am glad I could help and please, do let us know about the results you had on your other computers.

 

[centerdialog]

I've heard that something like the below could help the reduce flicker or increase the speed of the macro Jafaar. What do you think?

https://www.automateexcel.com/vba/turn-off-screen-updating/

http://www.excely.com/excel-vba/screen-updating.shtml

https://docs.microsoft.com/en-us/office/vba/api/excel.application.screenupdating

 

[Jaafar Tribak]

@centerdialog

Those links are referring to the Application ScreenUpdating Property which are of no use here .

In fact, my code prevents updating of the whole screen not just the application window.. This is achieved by sending the WM_SETREDRAW message with the wParam set to 0 ... This step was needed to erase the annoying initial ghost outline that remains after the Sheets list is displayed when the number of sheets is less than 17.

My last code in post #34 as is is fast and flicker-free at least when I tested it on a couple of computers .. I wonder what the reason of your question is.

Regards.

 

[centerdialog]

@centerdialog

Those links are referring to the Application ScreenUpdating Property which are of no use here .

In fact, my code prevents updating of the whole screen not just the application window.. This is achieved by sending the WM_SETREDRAW message with the wParam set to 0 ... This step was needed to erase the annoying initial ghost outline that remains after the Sheets list is displayed when the number of sheets is less than 17.

My last code in post #34 as is is fast and flicker-free at least when I tested it on a couple of computers .. I wonder what the reason of your question is.

Regards.

Jaafar, I hope you've been doing well. Thanks again for your help on this macro and for your generosity.

I'm sorry to revive this thread, but my work place has recently transitioned to Office 2019 and this macro still works, but not perfectly like it did before.

Now, when my colleagues and I run the macro on a workbook with <17 worksheets, the entire Excel instance becomes a blank white while the Command Bar pop up is open until either a worksheet is selected using the Command Bar or any command is given to Excel (like a mouse click or left arrow key). I've included a screenshot below of the disruptive issue.

The macro still works perfectly for >=17 worksheets, so I am not sure what the culprit is here or how to fix this issue if possible. Would you please mind lending your expertise yet again? Thanks so much for everything.