Lu76Fer
XLDnaute Occasionnel
La fonction OpenFileDialog
I - Description de la fonction
C'est en utilisant l'objet FileDialog, ces propriétés et méthodes que j'ai développé cette fonction dans l'optique de simplifier son utilisation. En effet, il existe 4 types de cette fenêtre de dialogue qui présentent chacun, des spécificités que j'ai essayé de prendre en charge au sein de cette fonction.
J'ai ajouté la prise en charge de session autre que la session principale avec une astuce pour réactiver le focus sur la session principale car l'objet FileDialog est associé à une session : With session.FileDialog(iFileDialog).
Il y a enfin, la prise en charge de l'interaction utilisateur, lorsqu'un fichier choisi risque de provoquer une perte de données ou pour éviter la redondance de message lors de l'écrasement d'un fichier.
La fonction OpenFileDialog et ses satellites :
VB:
'Ouvre une boite de Dialogue Fichier iFileDialog :
'msoFileDialogFilePicker, msoFileDialogFolderPicker, msoFileDialogOpen, msoFileDialogSaveAs.
' sTitle : pour définir un titre de fenêtre différent de celui par défaut
' sInitFileName : pour définir un nom de fichier au départ (rem : 256 car max en théorie & impossible d'en avoir plusieurs !)
' isMultiSel(Faux) : si vrai autorise la sélection de plusieurs éléments POUR msoFileDialogFilePicker & msoFileDialogOpen
' iFilterIdx : permet de sélectionner le filtre de départ sinon par défaut
' isExec(Faux): si Vrai, exécute l'action choisie sur l'Objet(classeur) Actif
' iInitView : permet de changer le mode d'affichage si défini (constantes MsoFileDialogView)
' session(Application) : permet de choisir une autre session Excel notamment à l'exécution
'Retour : Vrai si validation. on affecte à vRes, le nom complet de l'élément sélectionné
' ou si Multi-sélection un tableau avec les noms complets des éléments sélectionnés
Function OpenFileDialog(ByRef vRes As Variant, iFileDialog%, Optional sTitle$, Optional sInitFileName$, Optional isMultiSel As Boolean, _
Optional iFilterIdx%, Optional isExec As Boolean, Optional iInitView%, Optional session As Application) As Boolean
Const MSG_DIALOGERR = "ERREUR DE LA BOITE DE DIALOGUE", MSG_BADENTRY = "MAUVAISE SAISIE OU SELECTION"
Const MSG_ERRACTION = "L'action effectuée est infructueuse et doit être abandonnée !"
Const MSG_SILLYUSER = "Impossible de choisir votre Propre classeur !! ABANDON."
Const MSG_ALREADYOPN = "Les fichiers déjà ouverts ci-dessous doivent être retirés de votre sélection pour éviter la perte de données :"
Dim idxMsg%, wkb As Workbook, tot%, cnt%, vInput As Variant, posIpt%, runAgain As Boolean, isNewSess As Boolean
If session Is Nothing Then Set session = Application Else isNewSess = True
On Error GoTo AbortAction
With session.FileDialog(iFileDialog)
.AllowMultiSelect = isMultiSel: isMultiSel = .AllowMultiSelect
If iFilterIdx > 0 Then .FilterIndex = iFilterIdx
.Title = sTitle: .InitialFileName = sInitFileName 'Si chaîne vide, réinit aux valeurs par défaut
If iInitView Then .InitialView = iInitView 'Change le mode d'affichage si défini
If (.Show) Then
tot = .SelectedItems.Count: ReDim vRes(tot - 1)
For cnt = 1 To tot: vRes(cnt - 1) = .SelectedItems(cnt): Next cnt
ReDim vInput(tot - 1)
If isExec Then
For cnt = 0 To tot - 1
If ThisWorkbook.fullName = vRes(cnt) Then vRes = MSG_SILLYUSER: GoTo AbortAction
If iFileDialog = msoFileDialogOpen Then 'Si classeur dèjà ouvert dans la session
Set wkb = FileIsOpenInXlSession(CStr(vRes(cnt)), session) 'Ne pas réouvrir (et perdre les données)
If Not (wkb Is Nothing) Then _
If tot = 1 Then wkb.Activate: Exit Function Else _
vInput(posIpt) = Mid(vRes(cnt), InStrRev(vRes(cnt), "\") + 1): posIpt = posIpt + 1: runAgain = True
End If
Next cnt
If runAgain Then 'Si un ou des fichier(s) déjà ouvert(s) sur une sélection multiple
ReDim Preserve vInput(posIpt - 1): idxMsg = 2
vRes = MSG_ALREADYOPN & Chr(10) & Chr(10) & """" & Join(vInput, """ """) & """": GoSub AbortAction
OpenFileDialog = OpenFileDialog(vRes, msoFileDialogOpen, sTitle, sInitFileName, _
isMultiSel, iFilterIdx, True, iInitView, session)
Exit Function
End If
If iFileDialog = msoFileDialogSaveAs Then DelFile CStr(vRes(0)) 'Ecraser un fichier en évitant 2 confirmations !
.Execute
End If
End If
End With
If Not (IsEmpty(vRes)) Then OpenFileDialog = True: If Not (isMultiSel) Then vRes = vRes(0)
Exit Function
AbortAction: 'MsgBox s'affiche toujours à priori sur la session principale(code)
If isNewSess Then session.[A1] = session.[A1]: AppActivate Application.Caption 'Focus sur Application
MsgBox IIf(idxMsg, CStr(vRes), MSG_ERRACTION), vbOKOnly Or vbApplicationModal Or vbExclamation, IIf(idxMsg, MSG_BADENTRY, MSG_DIALOGERR)
If idxMsg = 2 Then Return
End Function
'Efface le fichier sFullFileName s'il existe
'Renvoie vrai si le fichier a été supprimé(sinon c'est qu'il doit être verrouillé)
Function DelFile(sFullFileName As String) As Boolean
Dim fs As FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")
If Not (fs.FileExists(sFullFileName)) Then Exit Function 'Vérifie l'existence du fichier
On Error GoTo FileLocked
fs.DeleteFile sFullFileName
DelFile = True
Exit Function
FileLocked:
End Function
'Permet de savoir si le fichier dont le nom COMPLET sFullName est ouvert dans la session (Application par défaut)
'Renvoie la référence au classeur si ouvert
Function FileIsOpenInXlSession(sFullName As String, Optional session As Application) As Workbook
Dim pos%, sName$, wkb As Workbook
On Error GoTo NotFound
If session Is Nothing Then Set session = Application
pos = InStrRev(sFullName, "\"): sName = Mid(sFullName, pos + 1)
Set wkb = session.Workbooks(sName)
If wkb.fullName = sFullName Then Set FileIsOpenInXlSession = wkb
Exit Function
NotFound:
End Function
Remarque : la fonction DelFile est utilisée pour supprimer un fichier lorsque l'utilisateur a choisi d'écraser un fichier existant au travers de la boite de dialogue. En effet en cas d'exécution automatique au cours d'une sauvegarde la boite de confirmation se déclenche 2 fois de suite sans cela.
+ La fonction FileIsOpenInXlSession permet de vérifier si un fichier n'est pas déjà ouvert avant de l'ouvrir au travers de l'exécution automatique. Dans ce cas, il ne faut pas réouvrir le fichier sans quoi on risque de perdre toutes les modifications qui auraient été apporté à ce fichier.
+ Seul le paramètre iFileDialog est obligatoire et le premier paramètre permet de renvoyer les résultats sous forme texte pour une sélection simple et un tableau de chaîne pour une sélection multiple (même s'il n'y a qu'un résultat) et il prend les valeurs suivantes :
- msoFileDialogFilePicker
- msoFileDialogFolderPicker
- msoFileDialogOpen
- msoFileDialogSaveAs
+ La fenêtre de dialogue comporte un titre par défaut qui peut être redéfini avec sTitle.
+ Il est possible de choisir un et un seul nom de fichier au départ, en tout cas je n'ai pas trouvé la syntaxe pour en avoir plusieurs, avec sInitFileName. Il est a noter que le nom du fichier choisi ne doit pas forcément être présent dans le dossier et que si un filtre est appliqué, l'ajout de l'extension du fichier est optionnelle. Si vous choisissez d'utiliser un nom complet avec un chemin existant, cela permet de choisir le dossier de départ de la fenêtre de dialogue.
+ En affectant Vrai à isMultiSel, vous autorisé la sélection multiple <Ctrl> à condition que le type de fenêtre de dialogue soit msoFileDialogFilePicker ou msoFileDialogOpen.
+ En affectant Vrai à isExec vous exploité la méthode d'exécution automatique qui permettra par exemple d'ouvrir ou sauver les fichiers sélectionnés toujours pas rapport à l'objet(Classeur) actif de la session choisie au travers du paramètre session.
+ iInitView permet de changer le mode d'affichage de la boite de dialogue en choisissant parmi les constantes suivantes : msofiledialogview
J'évoque enfin le paramètre iFilterIdx qui nécessite de passer par une autre fonction permettant d'associer un type de fichier, par l'extension, à une valeur d'index de filtre :
VB:
'Renvoie l'Index du filtre pour le type de fichier 'sExt' depuis la boite de dialogue fichier
'msoFileDialogSaveAs' ou 'msoFileDialogOpen'. Si introuvable, renvoie 0
Function GetFilterIdxFromFileDialog(iFileDialog%, sExt As String) As Integer
Dim filters As FileDialogFilters, filter As FileDialogFilter, cnt%
Set filters = Application.FileDialog(iFileDialog).filters
For Each filter In filters
cnt = cnt + 1
If InStr(3, filter.Extensions, sExt) Then GetFilterIdxFromFileDialog = cnt: Exit Function
Next filter
End Function
⚠️ L'astuce du jour (Testé sous Excel v2016 64bits) :
Lors de l'ouverture de FileDialog depuis une autre session excel en premier plan et en cas de déclenchement d'un message d'erreur avec MsgBox, les messages d'erreur se retrouve caché en arrière plan car ils sont rattachés à la session principale ... Du coup, j'ai découvert une fonction permettant de changer le focus d'application qui existait déjà sur la version de 2003 : AppActivate; 😓 Vieux motard que jamais !
Cependant, ce n'est pas ça l'astuce car j'ai voulu l'utiliser pour changer le focus en le positionnant sur la session principale avant tout déclenchement de MsgBox mais cela ne fonctionne pas dans ce cas précis ! J'ai utilisé une autre version en passant par la version shell, en réalisant une pause; en vain... Il semble qu'en ayant déclenché la boite de dialogue quelque chose affecte la mécanique de focus depuis l'autre session ...
Finallement, je suis passé par l'utilisation de la version abrégé [A1] de la fonction Evaluate pour réaliser une opération nulle :
VB:
If isNewSess Then session.[A1] = session.[A1]: AppActivate Application.CaptionII - Mise en pratique
Voici ici 4 exemples permettant chacun d'illustrer chacun des types de boite de dialogue.
VB:
Const MSG_ABORT = "ABANDON"
Const MSG_BADFILE = "Impossible d'écraser le fichier "
Sub RunMEPInVBE()
Dim nb%
nb = 1
On nb GoSub mep1, mep1b, mep2, mep3
Exit Sub
mep1: MiseEnPratique1: Return
mep1b: MiseEnPratique1bis: Return
mep2: MiseEnPratique2: Return
mep3: MiseEnPratique3: Return
End Sub
Sub DisplayDebug(line$, inSheet As Boolean)
If inSheet Then [B10] = [B10] & line & Chr(10) Else Debug.Print line
End Sub
'Ouvrir FileDialog et laisser l'utilisateur choisir des fichiers qu'on listera dans la fenêtre d'exécution
Sub MiseEnPratique1(Optional inSheet As Boolean)
Dim pos%, vSel As Variant, val As Variant
If OpenFileDialog(vSel, msoFileDialogFilePicker, "Choisir des fichiers", , True) Then
pos = InStrRev(vSel(0), "\")
DisplayDebug "Dossier : """ & Left(vSel(0), pos) & """", inSheet
For Each val In vSel
DisplayDebug """" & Mid(val, pos + 1) & """", inSheet
Next val
End If
End Sub
'Ouvrir FileDialog et laisser l'utilisateur choisir un ou de(s) dossier(s) qu'on listera dans la fenêtre d'exécution
Sub MiseEnPratique1bis(Optional inSheet As Boolean)
Dim vSel As Variant
If OpenFileDialog(vSel, msoFileDialogFolderPicker, "Choisir des dossiers", , True) Then
'Remarque : il est impossible de sélectionner plusieurs dossiers avec FileDialog
DisplayDebug "Dossier : """ & vSel & """", inSheet
End If
End Sub
'Créer puis ouvrir un fichier texte, lui ajouter des données
'puis le sauvegarder via FileDialog sur un nouveau fichier texte
Sub MiseEnPratique2(Optional inSheet As Boolean)
Dim folder$, fullNameIn$, defFileName$, fileIn As TextStream, fileOut As TextStream, flt%, vSel As Variant, sTmp$
fullNameIn = "FileIn.txt": defFileName = "FileOut.txt" 'ou "FileOut"
folder = ThisWorkbook.Path & "\": fullNameIn = folder & fullNameIn
'### Création du fichier d'entré ###
Set fileIn = OpenTextFile(fullNameIn, ForWriting, True) 'Demander confirmation si le fichier existe déjà
If fileIn Is Nothing Then Exit Sub
sTmp = "Texte du fichier d'entrée": fileIn.WriteLine (sTmp)
fileIn.Close
'### Générer le nouveau fichier texte de sortie ###
'Impossible d'utiliser msoFileDialogFilePicker pour un fichier inexistant, du coup on utilise msoFileDialogSaveAs
flt = GetFilterIdxFromFileDialog(msoFileDialogSaveAs, "txt") 'Le filtre doit être précisé pour ce type de FileDialog
'Avec le nom complet comme init de saisie, la fenêtre de dialogue est pré-remplie et positionné sur le bon dossier
'La sauvegarde concerne le classeur actif par défaut, il ne faut donc pas lancer l'exécution auto.
If OpenFileDialog(vSel, msoFileDialogSaveAs, , folder & defFileName, , flt) Then
Set fileIn = OpenTextFile(fullNameIn, ForReading)
If vSel <> fullNameIn Then 'Si fichier de sortie différent du fichier d'entrée
Set fileOut = OpenTextFile(CStr(vSel), ForWriting)
Do Until fileIn.AtEndOfStream
sTmp = fileIn.ReadLine
fileOut.WriteLine sTmp
Loop
sTmp = "Texte du fichier de sortie": fileOut.WriteLine (sTmp)
fileOut.Close
Else
MsgBox MSG_BADFILE & "d'entrée !", vbOKOnly Or vbApplicationModal Or vbExclamation, MSG_ABORT
End If
fileIn.Close
End If
End Sub
'Ouvrir un classeur excel dans une nouvelle session et le sauver via FileDialog en filtrant les classeurs avec macro
Sub MiseEnPratique3(Optional inSheet As Boolean)
Dim pos%, vSel As Variant, val As Variant, flt%
Dim newXLInst As Application, wbkTarg As Workbook
Dim folder$, fullName$, defFileName$, fileIn As TextStream, fileOut As TextStream, sTmp$
On Error GoTo Sortie
'Ouvrir et afficher la nouvelle Instance d'App
Set newXLInst = New Application: newXLInst.Visible = True
Set wbkTarg = newXLInst.Workbooks.Add
'Traitement
wbkTarg.Worksheets(1).[A1] = "Ceci est le classeur de la mise en pratique 3"
flt = GetFilterIdxFromFileDialog(msoFileDialogSaveAs, "xlsm")
fullName = ThisWorkbook.Path & "\" & "Test3" 'Pour sélectionner le dossier, il faut choisir un nom de fichier par défaut
If OpenFileDialog(vSel, msoFileDialogSaveAs, , fullName, , flt, True, , newXLInst) Then
pos = InStrRev(vSel, "\")
DisplayDebug "Classeur sauvé dans le dossier """ & Left(vSel, pos) & """", inSheet
DisplayDebug "Nom : """ & Mid(vSel, pos + 1) & """", inSheet
End If
'Fermeture du classeur & de la session
Sortie:
wbkTarg.Close False
newXLInst.Quit
End Sub
Si vous souhaitez tester simplement ce code, téléchargez le fichier joint.
Dernière édition:
