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