Ce code vous permet d'appeler directement une boite de dialogue ouvrir ou enregistrer sans nécissiter de référencer comdlg32.dll dans votre projet.
Créer un module de classe et nommer le "CFileDialog".
Source / Exemple :
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter 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
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) _
As Long
Private Declare Function GetSaveFileName _
Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) _
As Long
Private m_strDefaultExt As String
Private m_strDialogTitle As String
Private m_strFileName As String
Private m_strFileTitle As String
Private m_strInitialDir As String
Private m_strFilter As String
Private m_intFilterIndex As Integer
Private m_intMaxFileSize As Integer
Private m_lnghWndParent As Long
Private Const cintMaxFileLength As Integer = 260
Public Property Get DefaultExt() As String
DefaultExt = m_strDefaultExt
End Property
Public Property Let DefaultExt(ByVal strValue As String)
m_strDefaultExt = strValue
End Property
Public Property Get DialogTitle() As String
DialogTitle = m_strDialogTitle
End Property
Public Property Let DialogTitle(ByVal strValue As String)
m_strDialogTitle = strValue
End Property
Public Property Get FileName() As String
FileName = m_strFileName
End Property
Public Property Let FileName(ByVal strValue As String)
m_strFileName = strValue
End Property
Public Property Get FileTitle() As String
FileTitle = m_strFileTitle
End Property
Public Property Let FileTitle(ByVal strValue As String)
m_strFileTitle = strValue
End Property
Public Property Get Filter() As String
Filter = m_strFilter
End Property
Public Property Let Filter(ByVal strValue As String)
m_strFilter = strValue
End Property
Public Property Get FilterIndex() As Integer
FilterIndex = m_intFilterIndex
End Property
Public Property Let FilterIndex(ByVal intValue As Integer)
m_intFilterIndex = intValue
End Property
Public Property Get hWndParent() As Long
hWndParent = m_lnghWndParent
End Property
Public Property Let hWndParent(ByVal lngValue As Long)
m_lnghWndParent = lngValue
End Property
Public Property Get InitialDir() As String
InitialDir = m_strInitialDir
End Property
Public Property Let InitialDir(ByVal strValue As String)
m_strInitialDir = strValue
End Property
Public Property Get MaxFileSize() As Integer
MaxFileSize = m_intMaxFileSize
End Property
Public Property Let MaxFileSize(ByVal intValue As Integer)
m_intMaxFileSize = intValue
End Property
Public Function Show(fOpen As Boolean) As Boolean
Dim of As OPENFILENAME
Dim strChar As String * 1
Dim intCounter As Integer
Dim strTemp As String
On Error GoTo PROC_ERR
of.lpstrTitle = m_strDialogTitle & ""
of.Flags = &H80000
of.lpstrDefExt = m_strDefaultExt & ""
of.lStructSize = LenB(of)
of.lpstrFilter = m_strFilter & "||"
of.nFilterIndex = m_intFilterIndex
For intCounter = 1 To Len(m_strFilter)
strChar = Mid$(m_strFilter, intCounter, 1)
If strChar = "|" Then
strTemp = strTemp & vbNullChar
Else
strTemp = strTemp & strChar
End If
Next
strTemp = strTemp & vbNullChar & vbNullChar
of.lpstrFilter = strTemp
strTemp = m_strFileName & String$(cintMaxFileLength - Len(m_strFileName), 0)
of.lpstrFile = strTemp
of.nMaxFile = cintMaxFileLength
strTemp = m_strFileTitle & String$(cintMaxFileLength - Len(m_strFileTitle), 0)
of.lpstrFileTitle = strTemp
of.lpstrInitialDir = m_strInitialDir
of.nMaxFileTitle = cintMaxFileLength
of.hwndOwner = m_lnghWndParent
If fOpen Then
If GetOpenFileName(of) Then
Show = True
m_strFileName = TrimNulls(of.lpstrFile)
m_strFileTitle = TrimNulls(of.lpstrFileTitle)
Else
Show = False
End If
Else
If GetSaveFileName(of) Then
Show = True
m_strFileName = TrimNulls(of.lpstrFile)
m_strFileTitle = TrimNulls(of.lpstrFileTitle)
Else
Show = False
End If
End If
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"Show"
Resume PROC_EXIT
End Function
Private Function TrimNulls(ByVal strIn As String) As String
Dim intPos As Integer
On Error GoTo PROC_ERR
intPos = InStr(strIn, vbNullChar)
If intPos = 0 Then
TrimNulls = strIn
Else
If intPos = 1 Then
TrimNulls = ""
Else
TrimNulls = Left$(strIn, intPos - 1)
End If
End If
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"TrimNulls"
Resume PROC_EXIT
End Function
Conclusion :
Code à insérer dans un module pour tester la classe :
Sub Test()
Dim dlg As CFileDialog
Set dlg = New CFileDialog
dlg.DialogTitle = "Choisissez une balance d'importation"
dlg.Filter = "Balance d'importation Format Texte|*.txt|Balance d'importation Format Excel|*.xls|Tous les fichiers|*.*"
dlg.InitialDir = "C:\"
If dlg.Show(False) Then
MsgBox "Fichier sélectionné : " & dlg.FileName
Else
MsgBox "Aucun fichier sélectionné."
End If
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.