Boite de dialogue ouvrir/enregistrer

Soyez le premier à donner votre avis sur cette source.

Vue 18 207 fois - Téléchargée 742 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Thommythomme
Messages postés
1
Date d'inscription
jeudi 25 mars 2004
Statut
Membre
Dernière intervention
7 mars 2010
-
Bonjour, j'ai un problème de format de données mal déclaré dans la fonction "Private Function TrimNulls(ByVal strIn As String) As String"
et pourtant je n'y ai rien modifier.
Le message apparait après sélection d'un fichier, mais lorsque je clic sur le bouton "Enregistrer".
Quelqu'un aurait'il la solution à mon problème?
message d'erreur : "Erreur de compilation
Le caractère de déclaration de type ne correspond pas au type de données déclaré."
cs_cobra2008
Messages postés
25
Date d'inscription
mardi 24 juillet 2007
Statut
Membre
Dernière intervention
27 août 2010
-
Merci bcp.

Comme je ne comprend pas grand chose, peut être que ma question est nulle (et aussi un peut tardive...)

est il possible de changer le bouton "enregistrer" en "ouvrir" ?

merci
cs_mabrouklepoux
Messages postés
84
Date d'inscription
lundi 6 novembre 2000
Statut
Membre
Dernière intervention
25 juillet 2008
-
MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!MERCI!!!
cs_Diroma
Messages postés
2
Date d'inscription
dimanche 14 septembre 2003
Statut
Membre
Dernière intervention
17 février 2006
-
Merci pour le code.
Peux-tu me dire comment faire pour rendre ce "FileDialog" modal ?
Dans le cas présent l'utilisateur peu appeler plusieurs fois le "Filedialog" !


D'avance merci pour la réponse
acartie2
Messages postés
2
Date d'inscription
mardi 4 février 2003
Statut
Membre
Dernière intervention
12 janvier 2005
-
Merci, (ya pas d'autre mot )
Avec ce code je gagne un temps conséquent!
Cela fonctionne merveilleusement sous ACCESS 2000
Je n'ai plus qu'a adapter tout ceci à mes besoins...
( C'est en décortiquant des codes comme celui-ci que je
me rend compte de l'étendue de mes connaissances 2% de VBA 2% de VB maxi )
Manque seulement un peu de commentaire dans le code mais pas de méprise, il ne s'agit pas d'une critique!
Un bon 9/10 et encore merci pour le partage de tes connaissances !

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.