Make your own free website on Tripod.com

Home
Home

---soumis par Dev Ashish---

(Q) Comment appeler le formulaire utilitaire (dialogue) de Windows "File Open/Save" (Ouvrir/Sauvegarder un fichier)?

(A) On peut soit utiliser le contrôle commun de Access97, soit en utilisant une fonction de l'API de Win32.

Couper et coller le code suivant dans un nouveau module. Le code n'ouvre pas le fichier, ni ne le sauvegarde,  
il ne fait qu'obtenir un nom de fichier.
'***************** Code Start **************
'Ce code fut originalement écrit par Ken Getz
'Il ne doit être ni altéré, ni distribué
'sauf comme partie intégrée à une application.
'Vous êtes libre d'utiliser ce code 
'à la condition de laisser cette note, sans modification.
' Code courtesy of:
'   Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
	lStructSize As Long
	hwndOwner As Long
	hInstance As Long
	strFilter As String
	strCustomFilter As String
	nMaxCustFilter As Long
	nFilterIndex As Long
	strFile As String
	nMaxFile As Long
	strFileTitle As String
	nMaxFileTitle As Long
	strInitialDir As String
	strTitle As String
	Flags As Long
	nFileOffset As Integer
	nFileExtension As Integer
	strDefExt As String
	lCustData As Long
	lpfnHook As Long
	lpTemplateName As String
End Type
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000
Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
                    "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")
    ' On a fourni les options dans lngFlags,
    ' la fonction y  place donc les options en sortie.
    Debug.Print Hex(lngFlags)
End Function
Function GetOpenFile(Optional varDirectory As Variant, _
    Optional varTitleForDialog As Variant) As Variant
' Un exemple pour obtenir une base de données Access.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' On désire que le fichier existe déjà,
' on ne veut pas changer de répertoire, en sortie
' et on n'affiche pas la mention "lecture seule"
' qui ne fait qu'embrouiller les gens
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If

    ' Définir les filtres et utiliser  "c"
    ' Copier cette ligne pour ajouter
    ' d'autres filtres.
    strFilter = ahtAddFilterItem(strFilter, _
                "Access (*.mdb)", "*.MDB;*.MDA")
    ' Et maintenant, obtenir le nom du fichier.
    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:=varDirectory, _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName
End Function
Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
'Point d'entrée pour le contrôle commun
' "file open/save dialog". Les paramètres sont 
' listés par après, et sont tous optionels.
'
' *In:
' Flags: un ou plusieurs constantes de  ahtOFN_* constants, unie par des OR
' InitialDir: le répertoire présenté à l'usager
' Filter: une série de filtres pour les fichiers; utiliser
'                           AddFilterItem. Voir l'exemple.
' FilterIndex: Index, base 1, fournissant le filtre par défaut
'                           (1, si non spécifié)
' DefaultExt: Extension à utiliser si l'usager n'en entre pas.
'                           Seulement pour les sauvegardes.
' FileName: Valeur par défaut pour le nom du fichier.
' DialogTitle: Titre dans la barre titre du formulaire.
' hWnd: handle Win32 du parent de ce dialogue
' OpenFile: Booléen(True=Open File/False=Save As)
' *Out:
' Return Value: Soit Null, soit le nom choisi
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    ' Fournir le caption (étiquette) du titre.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Créer une chaîne pour recevoir le résultat.
    strFileName = left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Initialiser la structure avant d'appeler la fonction
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' On ne pense pas que quelqu'un veut vraiment utiliser
        ' ces options.
        .hInstance = 0
        .strCustomFilter = ""
        .nMaxCustFilter = 0
        .lpfnHook = 0
        ' Pour  NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' Transmettre la structure de données au
    ' Windows API qui, à son tour, affichera
    ' le formulaire "Open/Save As".
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' La fonction retourne le nom dans le membre strFileTitle
    ' de la structure. Il nous faut écrire du code pour
    ' retrouver ce qui nous intéresse.
    If fResult Then
        ' Vous pouvez vérifier les membres de la structure
        ' pour obtenir plus d'information sur le fichier choisi.
        ' Dans cet exemple, si vous avez fourni un argument pour
        ' les options, on vous retourne les indicateurs (flags) dans
        ' cette même variable.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function
Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
' Ajoute un nouvel ensemble de données formant un nouveau filtre.
' Par exemple, aux filtres existants, ajouter une  description,
' (tel  "Databases"), un caractère  null, la grille passe-partout
' (tel "*.mdb;*.mda") et un dernier caractère null.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
'************** Code End *****************

Pour appeler ce formulaire depuis votre code, voir la fonction TestIt() incluse dans le module, ou s'inspirer de l'exemple suivant

Dim strFilter As String
Dim strInputFileName as string

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
                DialogTitle:="Veillez spécifier le nom du fichier...", _
                Flags:=ahtOFN_HIDEREADONLY)

Noter que pour " Save As" vous utlisez la même fonction, mais vous précisez l'argument  "OpenFile" comme étant  False. Par exemple,

'Demande un nom de fichier pour sauvegarder
strFilter = ahtAddFilterItem(myStrFilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False, Filter:=strFilter, _
                    Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)