Afficher la boite de Dialogue Fichier avec le VBA 7

Depuis Excel 2010, le moteur de programmation utilise le VBA 7. Le VBA 7 a apporté énormément de simplication dans l'écriture de certaines procédures, comme l'affichage des boites de dialogue.

En VBA 7, l'appel de l'ouverture de la boîte de dialogue "Sélectionner un fichier" s'écrit de la façon suivante.

Sub Ouvrir_Boite_Dialogue()
    Application.FileDialog(msoFileDialogFolderPicker).Show
End Sub

Et pour récupérer le nom du fichier sélectionné, il suffit d'écrire le code suivant

Sub Rep_Selection ()
Dim Rep As String
    Application.FileDialog(msoFileDialogFolderPicker).Show
    Rep = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    MsgBox Rep
End Sub

Comme vous le constatez, c'est extrêmement simple à coder ???? Mais cela n'a pas toujours été le cas ????????

Anciens codes (VB6)

Il faut bien avoir à l'esprit qu'un grand nombre de projets VBA ont été écrits il y a longtemps. Et probablement, les lignes de codes suivantes sont encore présentes dans des programmes.

Il est fortement recommandé de les remplacer par la technique décrite précédemment. Du moins, si vous travaillez avec une version supérieure à Excel 2010.

Méthode 1

'Constantes permettant de personnaliser le fonctionnement de BrowseForFolder
Const BIF_RETURNONLYFSDIRS = &H1 'pour chercher les fichiers systèmes seulement
                                    ' si le dossier sélectionné ne contient pas
                                    ' de fichier système alors le bouton "OK" est grisé
Const BIF_DONTGOBELOWDOMAIN = &H2 'interdit d'explorer en dehors du domaine 'For starting the Find Computer
Const BIF_STATUSTEXT = &H4 '
Const BIF_RETURNFSANCESTORS = &H8 'seulement des dossiers
Const BIF_EDITBOX = &H10 'Affiche une zone d'édition
Const BIF_VALIDATE = &H20 'Vérifie la saisie dans la zone d'édition
Const BIF_BROWSEFORCOMPUTER = &H1000 'Autorise le parcours réseau
Const BIF_BROWSEFORPRINTER = &H2000 'mes documents et bureau uniquemnet
Const BIF_BROWSEINCLUDEFILES = &H4000 'dossiers et fichiers
Const BIF_NONEWFOLDERBUTTON = &H200 'ne pas mettre le bouton Nouveau dossier
'affiche la boite de dialogue Windows de recherche d'un dossier
'ou d'un fichier
Sub essai()
    Dim Choix As String
    Choix = ChoixDossierFichier(1)
    If Choix <> "" Then MsgBox Choix
End Sub
Function ChoixDossierFichier(bDos As Boolean) As String
    Dim objShell As Object, objFolder As Object
    Dim Chemin As String, Msg As String
    Dim FlagChoix As Long, NbPoint As Integer
    If bDos Then
      FlagChoix = BIF_RETURNFSANCESTORS
      Msg = "Sélectionner un dossier :"
    Else
      FlagChoix = BIF_BROWSEINCLUDEFILES + BIF_NONEWFOLDERBUTTON
      Msg = "Sélectionner un fichier :"
    End If
                                            
    Set objShell = CreateObject("Shell.Application")
' 1er paramètre toujours 0 (zéro). Il représente le handle de la fenêtre parent
' 2ème paramètre Titre de la boite, en dessous de la barre de titre
' 3ème paramètre options de BrowseForFolder
' 4ème paramètre Facultatif. Répertoire de début d'exploration
    On Error Resume Next
    Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
    'Si l 'objet retourné est valide, on teste son contenu (item.title)
    'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
    ' suivi de sa lettre et ":" entre parenthèses
    NbPoint = InStr(objFolder.Title, ":")
    If NbPoint = 0 Then
        'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
        'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
    Else
        ' si racine on récupère la lettre du lecteur et les 2 points
        Chemin = Mid(objFolder.Title, NbPoint - 1, 2)
    End If
    ChoixDossierFichier = Chemin
End Function

Méthode 2

'-----------------------------------------------------------------
' Variables utilisées pour l'affichage de la boîte de dialogue de 
' recherche de dossier
'-----------------------------------------------------------------
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
'-----------------------------------------------------------------
' Variables utilisées pour 32-bit API declarations
'-----------------------------------------------------------------
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
  pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'-----------------------------------------------------------------
' Procédure d'appel de la fonction
'-----------------------------------------------------------------
Sub Procedure_Appel()
Dim Msg As String
    Msg = "Sélectionner le répertoire de traitement."
    
' Appel de la fonction qui retourne le nom du chemin d'accès du 
'  répertoire en mettant en paramètre le titre de la fenêtre.
    Cells(1, 1) = GetDirectory(Msg)
    
End Sub
'------------------------------------------------------------------
' Fonction qui va afficher une boîte de dialogue pour sélectionner
' un répertoire
'------------------------------------------------------------------
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim Path As String
    Dim R As Long, x As Long, pos As Integer
 
'   Répertoire par défaut le bureau
    bInfo.pidlRoot = 0&
'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    
'   Type de repertoire sélectionné
'   En Annexe 3, vous trouverez tous les codes existants
'   d'autres répertoires comme le répertoire Mes Documents, SendTo, …
    bInfo.ulFlags = &H1
'   Affichage de la boîte de dialogue
    x = SHBrowseForFolder(bInfo)
    
'   Décomposition du résultat
    Path = Space$(512)
    R = SHGetPathFromIDList(ByVal x, ByVal Path)
    If R Then
        pos = InStr(Path, Chr$(0))
        GetDirectory = Left(Path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Articles liés

• VBA – Lancer un programme à une heure donnée
• VBA – Changer la date et l’heure d’un fichier
• VBA : Toutes les commandes pour les barres d’outils et menus
• Analyseur de code VBA – Rubberduck
• Enlever les accents dans vos cellules par VBA
• Répartition des dépenses avec Excel et le VBA

Vous trouverez des informations complémentaires sur la boîte de dialogue "fichier" sur le site de Microsoft.