Can I control the position of a filedialog window?

[JohnWLee]

We have recently changed to dual monitors and annoyingly when the Excel application is expanded across both screens, any filedialog window that is invoked by a macro sits right in the middle of the split.

I can control the position of userforms with the .Top and .Left form properties but don't know know how to, or even whether I can, control the position of a filedialog.

Any tips gratefully received.

Thanks in anticipation.

John

 

[Jaafar Tribak]

We have recently changed to dual monitors and annoyingly when the Excel application is expanded across both screens, any filedialog window that is invoked by a macro sits right in the middle of the split.

I can control the position of userforms with the .Top and .Left form properties but don't know know how to, or even whether I can, control the position of a filedialog.

Any tips gratefully received.

Thanks in anticipation.

John

JohnWLee.

You are not providing enough info.

Which FileDilogue is that ? SaveFile dialogue, Open etc...

and are you opening these dialogs via the user interface ie from the File Menu or programatically ?

Which version of Excel do you have ?

 

[JohnWLee]

Hi,

Sorry - not a good start!

I'm using XL2003 - opening from a VBA macro.

Private sub FolderTest()
 
Dim fdResults As FileDialog
Set fdResults = Application.FileDialog(msoFileDialogFolderPicker)
 
With fdResults
    .Title = "Select folder to receive calculations results workbooks"
    .InitialFileName = Thisworkbook.path & "\"
 
    If .Show = -1 Then
        strResultsFilepath = .SelectedItems(1)
    Else '// MUST HAVE CANCELLED
        Exit Sub
    End If
End With
 
end sub

Trust that's enough!

John

 

[Jaafar Tribak]

John .

There is no straightforward way of controling the position of Dialogs . The only way that I know of is trogh the use of the Win API.

Try this : (Should position the DlgBox at the TopLeft of the screen)

Change the values of the X , Y parameters of the MoveDlg routine to adjust the DlgBox screen position.

Option Explicit
 
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 FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Sub 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)
 
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
 
Private Declare Function GetDesktopWindow Lib "user32" () As Long
 
Private Const SWP_NOSIZE = &H1
 
Private lLeft As Long, lTop As Long
Private lAppHwnd As Long, lDlghWnd As Long
 
Sub FolderTest()
 
    Dim fdResults As FileDialog
    Dim strResultsFilepath As String
 
    Call MoveDlg(0, 0)
 
    Set fdResults = Application.FileDialog(msoFileDialogFolderPicker)
 
    With fdResults
        .Title = "Select folder to receive calculations results workbooks"
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = -1 Then
            strResultsFilepath = .SelectedItems(1)
            MsgBox strResultsFilepath
        Else '// MUST HAVE CANCELLED
            Exit Sub
        End If
    End With
 
End Sub
 
Private Sub MoveDlg(X As Long, Y As Long)
 
    lLeft = X: lTop = Y
 
    lAppHwnd = FindWindow("XLMAIN", Application.Caption)
 
    SetTimer lAppHwnd, 0, 1, AddressOf MoveDlgNow
 
    LockWindowUpdate GetDesktopWindow
 
End Sub
 
Private Sub MoveDlgNow()
 
    KillTimer lAppHwnd, 0
 
    lDlghWnd = FindWindow("bosa_sdm_XL9", vbNullString)
 
    If lDlghWnd Then
        SetWindowPos lDlghWnd, 0, lLeft, lTop, 0, 0, SWP_NOSIZE
    End If
 
    LockWindowUpdate 0
 
End Sub

 

[JohnWLee]

Thank you very much for the above - will work through it as not worked with the Windows API before.

Many thanks again.

John

 

[mart+]

Hi,

Is there a solution for 64 bit excel ?

I changed apis and values of the X , Y but still positining filedialog to top left of the screen.

#If 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Sub 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 Sub 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)
    Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As LongPtr) As Long
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
    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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Sub 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)
    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If

I really appreciate any help you can provide.

 

[mart+]

Hi,

Is there a solution for 64 bit excel ?

I changed apis and values of the X , Y but still positining filedialog to top left of the screen.

I really appreciate any help you can provide.

 

[CharlesRattletail]

Hello

I can't get this working on Office 365. That is to say the code runs but does not re-position the window!
What is the refence to "bosa_sdm_XL9" for ?
I have been trying o get this kind of functionality working for a long time and would find it very usefull

Has abubodt achieved this?

Many thanks

 

[Jaafar Tribak]

Hello

I can't get this working on Office 365. That is to say the code runs but does not re-position the window!
What is the refence to "bosa_sdm_XL9" for ?
I have been trying o get this kind of functionality working for a long time and would find it very usefull

I think, bosa_sdm_XL9 was the class name back then in earlier versions of excel. Now, when I tested the code in Excel 2016, the class name is #32770

Anyways, here is a more robust version of the previous code for setting the screen position of the Dialog:

In a Standard Module:

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 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Sub 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 AddAtom Lib "kernel32" Alias "AddAtomA" (ByVal lpString As String) As Integer
    Private Declare PtrSafe Function GetAtomName Lib "kernel32" Alias "GetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare PtrSafe Function DeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Sub 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 Function AddAtom Lib "kernel32" Alias "AddAtomA" (ByVal lpString As String) As Integer
    Private Declare Function GetAtomName Lib "kernel32" Alias "GetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function DeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
#End If


Sub FolderTest()
 
    Dim fdResults As FileDialog, strResultsFilepath As String
    Dim Pos(2&) As Long
 
    Set fdResults = Application.FileDialog(msoFileDialogFolderPicker)
    With fdResults
        .Title = "Select folder to receive calculations results workbooks"
        .InitialFileName = ThisWorkbook.Path & "\"
        '/////////////////////////////////////////////////////////////////////
            'Section to be executed before calling the FileDialog Show Method.
            Pos(0&) = 300&: Pos(1&) = 200&
            Call SetDialogPosition(Pos, fdResults.Title)
        '/////////////////////////////////////////////////////////////////////
        If .Show = -1& Then
            strResultsFilepath = .SelectedItems(1&)
            MsgBox strResultsFilepath
        Else '// MUST HAVE CANCELLED
            Exit Sub
        End If
    End With
 
End Sub
 
Private Sub SetDialogPosition(Position() As Long, ByVal DialogTitle As String)
    Dim sAtomName As String
    sAtomName = DialogTitle & "|" & Position(0&) & "|" & Position(1&)
    Call SetTimer(Application.hwnd, AddAtom(sAtomName), 0&, AddressOf MoveDlgNow)
End Sub
 
Private Sub MoveDlgNow( _
    ByVal hwnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal idEvent As LongPtr, _
    ByVal dwTime As Long _
)

    Const SWP_NOSIZE = &H1
    Dim sBuffer As String * 256&, lRet As Long
    Dim sAtomName As String, sAtomNameParts() As String
    Dim hDlg As LongPtr
   
    Call KillTimer(hwnd, idEvent)
    lRet = GetAtomName(CInt(idEvent), sBuffer, Len(sBuffer))
    sAtomName = Left(sBuffer, lRet)
    Call DeleteAtom(CInt(idEvent))
    If Len(sAtomName) Then
        sAtomNameParts = Split(sAtomName, "|")
        hDlg = FindWindow("bosa_sdm_XL9", sAtomNameParts(0&))
        If hDlg = NULL_PTR Then
            hDlg = FindWindow("#32770", sAtomNameParts(0&))
        End If
        If hDlg Then
            Call SetWindowPos(hDlg, NULL_PTR, sAtomNameParts(1&), sAtomNameParts(2&), 0&, 0&, SWP_NOSIZE)
        End If
    Else
        Debug.Print "Error - failed to locate the Dlg window."
    End If
End Sub

 

[CharlesRattletail]

I think, bosa_sdm_XL9 was the class name back then in earlier versions of excel. Now, when I tested the code in Excel 2016, the class name is #32770

Anyways, here is a more robust version of the previous code for setting the screen position of the Dialog:

In a Standard Module:

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 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Sub 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 AddAtom Lib "kernel32" Alias "AddAtomA" (ByVal lpString As String) As Integer
    Private Declare PtrSafe Function GetAtomName Lib "kernel32" Alias "GetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare PtrSafe Function DeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Sub 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 Function AddAtom Lib "kernel32" Alias "AddAtomA" (ByVal lpString As String) As Integer
    Private Declare Function GetAtomName Lib "kernel32" Alias "GetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function DeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
#End If


Sub FolderTest()
 
    Dim fdResults As FileDialog, strResultsFilepath As String
    Dim Pos(2&) As Long
 
    Set fdResults = Application.FileDialog(msoFileDialogFolderPicker)
    With fdResults
        .Title = "Select folder to receive calculations results workbooks"
        .InitialFileName = ThisWorkbook.Path & "\"
        '/////////////////////////////////////////////////////////////////////
            'Section to be executed before calling the FileDialog Show Method.
            Pos(0&) = 300&: Pos(1&) = 200&
            Call SetDialogPosition(Pos, fdResults.Title)
        '/////////////////////////////////////////////////////////////////////
        If .Show = -1& Then
            strResultsFilepath = .SelectedItems(1&)
            MsgBox strResultsFilepath
        Else '// MUST HAVE CANCELLED
            Exit Sub
        End If
    End With
 
End Sub
 
Private Sub SetDialogPosition(Position() As Long, ByVal DialogTitle As String)
    Dim sAtomName As String
    sAtomName = DialogTitle & "|" & Position(0&) & "|" & Position(1&)
    Call SetTimer(Application.hwnd, AddAtom(sAtomName), 0&, AddressOf MoveDlgNow)
End Sub
 
Private Sub MoveDlgNow( _
    ByVal hwnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal idEvent As LongPtr, _
    ByVal dwTime As Long _
)

    Const SWP_NOSIZE = &H1
    Dim sBuffer As String * 256&, lRet As Long
    Dim sAtomName As String, sAtomNameParts() As String
    Dim hDlg As LongPtr
  
    Call KillTimer(hwnd, idEvent)
    lRet = GetAtomName(CInt(idEvent), sBuffer, Len(sBuffer))
    sAtomName = Left(sBuffer, lRet)
    Call DeleteAtom(CInt(idEvent))
    If Len(sAtomName) Then
        sAtomNameParts = Split(sAtomName, "|")
        hDlg = FindWindow("bosa_sdm_XL9", sAtomNameParts(0&))
        If hDlg = NULL_PTR Then
            hDlg = FindWindow("#32770", sAtomNameParts(0&))
        End If
        If hDlg Then
            Call SetWindowPos(hDlg, NULL_PTR, sAtomNameParts(1&), sAtomNameParts(2&), 0&, 0&, SWP_NOSIZE)
        End If
    Else
        Debug.Print "Error - failed to locate the Dlg window."
    End If
End Sub