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]

Apologies for the delayed response, thanks again for your help.

Unfortunately, the newly posted code also seems to not work at all when there are fewer than 16 worksheets in the workbook, and when there are more than 16 worksheets, the Activate dialog box opens at the location of the cursor rather than the center of Excel.

I pasted the two additional lines of code just above "End Sub" at the very bottom of the code and ran the macro--nothing seemed to change, this yields the same results unless I pasted the additional code in the wrong location. Do let me know. Thanks very much.

 

[Jaafar Tribak]

Apologies for the delayed response, thanks again for your help.

Unfortunately, the newly posted code also seems to not work at all when there are fewer than 16 worksheets in the workbook, and when there are more than 16 worksheets, the Activate dialog box opens at the location of the cursor rather than the center of Excel.

I pasted the two additional lines of code just above "End Sub" at the very bottom of the code and ran the macro--nothing seemed to change, this yields the same results unless I pasted the additional code in the wrong location. Do let me know. Thanks very much.

Does the code work when using 1 monitor and fails when using a dual monitor ?

Can you upload a workbook example on a file sharing site such as (Box.net) and post a link to it here so I can take a look ?

 

[centerdialog]

Let me confirm that and get back to you.

I am simply opening a new Excel file, opening VBA editor with Alt + F11, right clicking on workbook, inserting new module, and pasting your code. If helpful, yes I can share the blank Excel file which I am using.

For convenience would you mind pm'ing me an email address of yours and I can send it there? Thanks.

 

[centerdialog]

I confirmed that the macro does not work even with just one monitor. Will email you the blank Excel file I am using in case helpful.


Edit: Before sending you the Excel file I needed to save it as a .xlsm (I was previously not saving these files, just opening VBA editor and pasting macro and closing Excel afterwards), I re-ran the macro after this and it appeared to work on a single monitor with some flicker and no shadow. Then I tried running the macro without macros enabled on the workbook and it worked as well.

Let me reconfirm these results on my three monitor set up and get back to you. Will email you as well once I have conclusive results. Thanks again for your help.

 

[centerdialog]

Confirmed the below is the case. Will email you the xlsm now.


"Unfortunately, the newly posted code also seems to not work at all when there are fewer than 16 worksheets in the workbook, and when there are more than 16 worksheets, the Activate dialog box opens at the location of the cursor rather than the center of Excel.

I pasted the two additional lines of code just above "End Sub" at the very bottom of the code and ran the macro--nothing seemed to change, this yields the same results unless I pasted the additional code in the wrong location. Do let me know. Thanks very much."

 

[Jaafar Tribak]

Confirmed the below is the case. Will email you the xlsm now.


"Unfortunately, the newly posted code also seems to not work at all when there are fewer than 16 worksheets in the workbook, and when there are more than 16 worksheets, the Activate dialog box opens at the location of the cursor rather than the center of Excel.

I pasted the two additional lines of code just above "End Sub" at the very bottom of the code and ran the macro--nothing seemed to change, this yields the same results unless I pasted the additional code in the wrong location. Do let me know. Thanks very much."

Thanks for the workbook example.

I added a button to the first worksheet and assigned to it the Center_Sheets_List_Dialog routine.

When I click the button, the tab list dialog appears right in the center of the excel application window with no flickering and no shadow left behind ... It works beautifully for me.

I am not sure why it doesn't work for you. The only thing I can think of that causing the problem is the LanguageID you are using ... Maybe you are not using the standard US english edition.

In the code, there is a line that reads the caption of the tab list dialog which is this line :

sCaption = Switch([COLOR=#ff0000][B]iLCID = 1033[/B][/COLOR], "Activate", iLCID = 1036, "Activer", iLCID = 3082, "Activar")

Now, assuming you are using an english edition of Excel, try replacing the above iLCID variable (in RED) with any of the other english LCID codes below and see if any of them works :

LCID codes to try :
English - Australia ...3081
English - Belize ...10249
English - Canada ...4105
English - Ireland ...6153
English - Jamaica ...8201
English - New Zealand ...5129
English - South Africa ...7177
English - Trinidad ...11273
English - United Kingdom ...2057

 

[Jaafar Tribak]

Here is a better and more generic way of handling the different excel language settings :

Option Explicit

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
    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 GetAncestor Lib "user32" (ByVal hwnd As LongPtr, ByVal gaFlags As Long) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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 GetAncestor Lib "user32" (ByVal hwnd As Long, ByVal gaFlags 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 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

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

Public Sub Center_Sheets_List_Dialog()

    If ActiveWorkbook.Sheets.Count <= 16 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
    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
        
    On Error GoTo Xit
    
    KillTimer hwnd, nIDEvent
    
    iLCID = Application.LanguageSettings.LanguageID(msoLanguageIDInstall)
    
    Select Case iLCID
        Case 1033, 3081, 10249, 4105, 6153, 8201, 5129, 7177, 11273, 2057 'english
            sCaption = "Activate"
        Case 2060, 3084, 5132, 4108, 1036 'french
            sCaption = "Activer"  'spanish
        Case 1034, 11274, 16394, 13322, 9226, 5130, 7178, 12298, 4106, 18442, 2058, 19466, 6154, 10250, 20490, 15370, 17418, 8202
            sCaption = "Activar"
    End Select
   
    hPopUp = IIf(nIDEvent = hwnd, FindWindow("MsoCommandBarPopup", vbNullString), FindWindow("bosa_sdm_XL9", sCaption))
    
    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(0&) = &H100010 Then
                    oCtrl.accSelect 1, 0&
                    Exit For
                End If
            Next
        End If
        
        SetWindowPos hPopUp, 0, X, Y, 0, 0, SWP_NOSIZE Or SWP_SHOWWINDOW + SWP_NOACTIVATE
        
    End If
     
Xit:
    SendMessage GetAncestor(hwnd, GA_PARENT), ByVal WM_SETREDRAW, ByVal 1&, 0&
End Sub

 

[centerdialog]

Thanks. I would have never thought that the Editing Language could cause issues, but that indeed appears to have been the case. To be clear, I have been testing your code primarily on my office set up (Excel default Editing Language: English (United Kingdom), 3 monitors, Excel 2013, Windows 7).

I changed the default Editing Language to English (United States) and re-ran all of the code your provided. Here are the results:

1. First code: when Editing Language set to English (United States) as default, macro works across all monitors with no shadow for the Commandbar, yet a minor flicker is visible for the Activate dialog box

2. Second code: when Editing Language set to English (United States) as default, macro works across all monitors, but shadow for the Commandbar and a minor flicker is visible for the Activate dialog box

3. Third code: when Editing Language set to English (United States) as default, macro works across all monitors with no shadow for the Commandbar, yet a minor flicker is visible for the Activate dialog box

4. Third code: when Editing Language set to English (United Kingdom) as default, Commandbar will not appear when <=16 worksheets, Activate dialog box appears at location of cursor

5. Fourth code: when Editing Language set to English (United States) as default, macro works across all monitors with no shadow for the Commandbar, yet a minor flicker is visible for the Activate dialog box

6. Fourth code: when Editing Language set to English (United Kingdom) as default, macro works across all monitors with no shadow for the Commandbar, yet a minor flicker is visible for the Activate dialog box


Essentially, the first code, third code, and fourth code are all viable and bring about the same result.

My questions:
1. It seems that the fourth code you provided works across all default Editing Languages, assuming that I am happy to change the Editing Language to English (United States), which code is the most elegant?
2. Is it possible to get rid of the minor flicker for the Activate dialog box, as there seems to be no flicker for the Commandbar.
3. I would like to create a shortcut for this macro, either Ctrl + Shift + W or Ctrl + Shift + Alt + W. Would you mind showing me how this should be written into the code? If I choose the former option, the macro will override the default Excel shortcut (Wrap text) without issues, correct?

Again, thanks very much for your help and patience.

 

[Jaafar Tribak]

My questions:
1. It seems that the fourth code you provided works across all default Editing Languages, assuming that I am happy to change the Editing Language to English (United States), which code is the most elegant?
2. Is it possible to get rid of the minor flicker for the Activate dialog box, as there seems to be no flicker for the Commandbar.
3. I would like to create a shortcut for this macro, either Ctrl + Shift + W or Ctrl + Shift + Alt + W. Would you mind showing me how this should be written into the code? If I choose the former option, the macro will override the default Excel shortcut (Wrap text) without issues, correct? .

Answers to your questions:

1- The last (fourth) code is what I would use because it should work accross all different english, french and spanish editions of excel.

2- When the number of sheets is less than 16 , what is displayed is not a propper window it is a commandbar and as such it cannot be detected and repositioned before it is displayed that's why there is an initial brieve flicker .. If I get time, I'll see if I can fix this annoyance .

3- The Macro should override the default excel shortcut ... We should bear in mind that some built-in excel shortcuts are language-dependent but I don't think it should be a problem here.

To assign the macro to Ctrl+Shift+W with code , you could place the following simple code in the ThisWorkbook Module :

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

Private Sub Workbook_Deactivate()
    Application.OnKey "+^{W}"
End Sub

The code should take effect upon opening and/or activating the workbook.

BTW, when I tested calling the macro via the above shortcut, I noticed that the initial flicker became hardly noticeable.

 

[centerdialog]

1. Okay, thanks.

2. Okay, if you happen to have some spare time, please do let me know (I haven't been able to test to improved flicker speed with the shortcut yet). Also, if you happen to know a method to call the Activate dialog box no matter how many worksheets there are (I don't think it's possible, as the xldialogbox Activate command opens the workbooks rather than the worksheets, refer to https://docs.microsoft.com/en-us/of...oxes-forms/built-in-dialog-box-argument-lists), please let me know.

3. I'm sorry, I was unable to get the shortcut to work. I tried to place the provided code in a new ThisWorkbook module and even in the module which holds the actual code (even tried various locations within this module), but neither seemed to work. Should I rename the shortcut code so that it matches the name of the of the original macro[i.e., Public Sub Center_Sheets_List_Dialog ( ) vs. Private Sub Workbook_Activate ( )]? Regarding the macro, could you explain what the purpose of the Deactivate ( ) line is, given that I can close both the Commandbar and dialog box using ESC?


Just to be clear, the intent of this entire exercise is to save the macro to the Personal.xlsb file so that I can run the macro using the shortcut on any excel file I open from my computer. Will ultimately not save the final code(s) to ThisWorkbook.