Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

BOITE DE DIALOGUE OUVRIR/ENREGISTRER


Information sur la source

Catégorie :Fichier / Disque Classé sous : ouvrir, enregistrer, dialogue Niveau : Initié Date de création : 08/02/2001 Vu / téléchargé: 12 713 / 558

Note :
8,31 / 10 - par 13 personnes
8,31 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (6)
Ajouter un commentaire et/ou une note

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

  • 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
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
 

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

Commentaires et avis

signaler à un administrateur
Commentaire de Jin le 11/01/2003 18:05:46

Je m'étais fabriqué la mienne. Au vu de cette exemple, je dois avouer qu'il ne me reste plus qu'à me cacher.

signaler à un administrateur
Commentaire de lepopeye le 15/10/2003 12:35:06

Merci, ça marche trés bien, en plus le filtre pour la sélection du type de fichier est trés pratique.
Bon boulot, THX.

signaler à un administrateur
Commentaire de Helkanen le 12/02/2004 21:29:10

merci,
c'est un bon gain de temps d'avoir fait un truc pareil
je voulais le faire, mais je me suis dis qu'il était peut etre déjà ici (avec raison)
c'est cool
ça vaut au moins 9/10

Helkanen

signaler à un administrateur
Commentaire de acartie2 le 12/01/2005 09:04:16

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 !

signaler à un administrateur
Commentaire de Diroma le 13/05/2005 14:41:07

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

signaler à un administrateur
Commentaire de mabrouklepoux le 14/11/2005 15:18:00

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!!!

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

boite de dialogue enregistrer et ouvrir [ par raph951 ] Bonjour,je suis entrain de programmer un jeu de dames et je voudrais pouvoir sauvegarder une partie et pouvoir la relancer à l'aide des boites de dial Boite de dialogue enregistrer et picturebox [ par Monico9385 ] Bonjour tout le monde!!!J'aurai une petit question:J'ai fais une boite de dialogue ouvrir, et maintenant j'aimerai que l'image sélectionnée dans la bo Boite de dialogue Ouvrir / Enregistrer Sous (API OPENFILENAME) [ par isa911 ] Bonjour,Je cherche à utiliser cette API, elle fonctionne correctement, mais comment faire pour mettre un nom de fichier par défaut pour l'en ouvrir la boite de dialogue "Enregistrer Sous" [ par midoparis ] Bonjour !!J'ai une macro qui fait un certain traitement sur le fichier Excel. Il peut arriver que l'utilisateur lance la macro sur un nouveau fichier enregistrer/ouvrir plusieurs listbox dans un seul fichier texte [ par maxpruv ] Bonjour, je suis nouveaux sur le forum et très  "novice" en programmation,excusez ma question qui paraitra  peut-être trop facile pour certain...Comme openfile [ par nabilac ] bonjour, 1) svp qlq sait cmmen faire appel a la boite de dialogue de windows "ouvrir avec ..." mon pb sait que j'ai un label qui contient des chemi boite de dialogue [ par steroller ] Bonjour je travail sous VB6 et  ma question porte sur la boite de dialogue ouvrir pour aller chercher une image. mais je voudrais que l'affichage mini Boîte de dialogue Internet Explorer [ par Preetamus ] Bonjour,j'ai créé une macro qui se log sur un site et ensuite va chercher un tableau. Ce tableau je veut l'ouvrir en excel donc je simule un clique su utiliser une boite dialogue pour ouvrir un fichier [ par fadydiarra ] salut à tous,je voudrais créer uneboite de dialogue que j'utiliserai pou ouvrir mes fichiers.j'ai écris un bout de code qui ouvre la boite de dialogue boite de dialogue ouvrir [ par asetti ] Bonjour,je cherche à récupérer le chemin d'un fichier avec une boite de dialogue ouvrir.quelqu'un peut il m'aider SVP(je travail en vba


Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Téléchargements

Comparez les prix Nouvelle version

Photothèque Nouveau !



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,359 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.