VBA

VBA – Boite de dialogue « Fichier »

Temps de lecture 3 minutes

Cet article va vous expliquer comment gérer la boite de dialogue Fichier de Windows en VBA.

Anciens codes (VB6)

Alors, ça va vous paraître surprenant, mais ouvrir la boite de dialogue Windows pour sélectionner un fichier, n'a jamais été une chose facile. Deux méthodes pouvaient être utilisées en VB6 (avant 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

Méthode avec la version VBA 7

Une chose n'est peut-être pas claire pour un grand nombre de développeur en VBA mais il y a eu beaucoup d'améliorations et de simplifications avec l'arrivée du VBA7. Le VBA 7 a été intégré à la version d'Office 2010.

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

Pour ouvrir la boite de dialogue des fichiers dans windows, il suffit d'écrire l'instruction suivante

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

Pour récupérer le nom du fichier sélectionné, le code est le suivant

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

Related posts

VBA : Toutes les commandes pour les barres d’outils et menus

Frédéric LE GUEN

VBA – Changer la date et l’heure d’un fichier

Frédéric LE GUEN

VBA – Lancer un programme à une heure donnée

Frédéric LE GUEN

Laissez un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.