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
