begin process at 2012 02 16 17:10:50
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Fichier / Disque

 > BOITE DE DIALOGUE OUVRIR/ENREGISTRER

BOITE DE DIALOGUE OUVRIR/ENREGISTRER


 Information sur la source

Note :
8,07 / 10 - par 14 personnes
8,07 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Fichier / Disque Classé sous :ouvrir, enregistrer, dialogue Niveau :Initié Date de création :08/02/2001 Vu / téléchargé :15 745 / 619

Auteur : webalg

Ecrire un message privé
Site perso
Commentaire sur cette source (8)
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

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

ACTIVER/DÉSACTIVER UNE COMMANDE DE MENU
AUTOMATISER L'IMPORTATION DE MODULE

 Sources de la même categorie

Source avec Zip Source .NET (Dotnet) MODIFIER LES EXTENSION DES FICHIERS par okosa
ROUTINE DIR RÉCURSIVE POUR OBTENIR LA LISTE DE TOUS LES FICH... par kerisolde
Source avec Zip Source avec une capture FILE,SECURITY,FICHIER par okosa
Source avec Zip Source avec une capture Source .NET (Dotnet) PATCHEUR DE FICHIER par tototh
Source avec Zip Source avec une capture LECTURE DES INFORMATIONS DES DISQUES COMPOSANT UN ENSEMBLE R... par jack

 Sources en rapport avec celle ci

Source avec Zip PETIT LOG CONCERNANT LE COMMONDIALOG par djls
CHARGER ET SAUVER UNE TEXTBOX par xave
ENREGISTRER ET OUVRIR LE CONTENU D'UNE LISTBOX A PARTIR D'UN... par Insight
Source avec Zip BOITE DE DIALOGUE ENREGISTRER SOUS par Dany
ENTREE/SORTIE (OUVRIR, ENREGISTER UN TEXTE) par BlackWizzard

Commentaires et avis

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.

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.

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

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 !

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

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

Commentaire de cobra2008 le 16/12/2009 16:45:10 5/10

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

Commentaire de Thommythomme le 07/03/2010 11:56:43

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é."

 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 listbox ET alimenter une listbox a partir d'une richtextbox multiligne [ par thekiller123 ] bonjour a tous! Debutant en VBV.net, j'aurai aimer savoir comment : 1)enregistrer une listbox et la re-ouvrir 2)remplir une listbox a partir d'une r 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 Enregistrer et ouvrir données . [ par Chauliac ] Bonjour Etant d'ébutant j'aimerai savoir comment sauvegarder des données de plusieurs textbox et pouvoir les restituer dans leurs textbox d'origine. J 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 Afficher la fenetre "Ouvrir avec" [ par Stefun ] Bonjour, j'aimerais afficher la boite de dialogue "Ouvrir avec" (qui permet d'associer un type de fichier à un programme). En fait j'essaye d'ouvrir 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


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
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

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,671 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales