Boite de sélection de fichier centrée

Bonjour à tous

Voici grace à Gérard Louisjean (gégé) le code que j'ai mis à ma sauce
permettant d'ouvrir la boîte de sélection de fichier au centre de l'écran...

PS : ce code utilise la fonction AdressOf qui n'est pas disponible sous
Access 97 mais pour ce que ça interresse, j'ai une fonction de remplacement
pour cette fonction...

Voici le code, pour essayer, il suffit de lancer la fonction :
"OpenFile_EXE()"

'***********************************************
'** Déclaration pour centrage boîte de dialogue FICHIER
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5

Public hHook As Long

Public Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long

Public Declare Function SetWindowsHookEx Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As
Long) As Long

'** Déclaration pour centrer une boîte de dailogue
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long)
As Long

Public Const SM_CXFULLSCREEN = 16
Public Const SM_CYFULLSCREEN = 17

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

Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public CntrDialog As Boolean

Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
Instance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Const OFN_AllowMultiSelect = &H200
Public Const OFN_EXPLORER = &H80000
Public Const OFN_LongNames = &H200000

Global Dialogue As OPENFILENAME

Public strFiltre As String
Public strFile As String
Public RetVal As Long

Public Function OpenFile_EXE()
OpenFile "c:\"
End Function

Public Function OpenFile(strInitialDir As String, Optional ctrDialogue As
Boolean = True) As String

OpenFile = ""
strFiltre = "Fichiers Word" & Chr$(0) & "*.doc;*txt" & Chr$(0) & _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"

If ctrDialogue Or IsMissing(ctrDialogue) Then
Dim Thread As Long
Thread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, 0, Thread)
End If

With Dialogue
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpstrInitialDir = strInitialDir
.lpstrTitle = "Recherche d'un fichier"
.Flags = 6148 Or OFN_AllowMultiSelect Or OFN_LongNames Or OFN_EXPLORER
End With

RetVal = GetOpenFileName(Dialogue)

If RetVal >= 1 Then
OpenFile = Dialogue.lpstrFile
Else
OpenFile = ""
Exit Function
End If

End Function

'** Procédure de centrage boîte de dialogue FICHIER
Public Function WinProc(ByVal lMsg As Long, ByVal hwnd As Long, _
ByVal lParam As Long) As Long

If lMsg = HCBT_ACTIVATE Then
CenterDialog hwnd
UnhookWindowsHookEx hHook
End If
WinProc = False

End Function

'** Procédure pour centrer une boîte de dialogue sur le bureau
Public Function CenterDialog(hwnd As Long)
Dim WinRect As RECT, ScrWidth As Integer, ScrHeight As Integer
Dim DlgWidth As Integer, DlgHeight As Integer
GetWindowRect hwnd, WinRect
DlgWidth = WinRect.Right - WinRect.Left
DlgHeight = WinRect.Bottom - WinRect.Top
ScrWidth = GetSystemMetrics(SM_CXFULLSCREEN)
ScrHeight = GetSystemMetrics(SM_CYFULLSCREEN)
MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, _
(ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1
End Function
'***********************************************


--
@+
Jessy Sempere - Access MVP
news@access.fr.vu
------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------