Macro & sélection de dossier

Bonjour à tous,

Dans mon fichier je travaille avec 2 feuilles :

  • 1ere feuille : info visuel + bouton pour lancer une macro
  • 2eme feuille : paramètres avec emplacement de certain fichier ( ex : A1=c:\test\ )

Il se peux que sur le PC de l'utilisateur, les fichiers ne se trouve pas au même endroit ( ex : c:\pastest\ )

Dans ce cas la, il y aura une erreur 76 de générer ( Chemin d'accès introuvable ). Et je voudrais pouvoir ouvrir une fenêtre qui demandera de sélectionner un dossier.

Tout ce que j'ai trouvé c'est "Application.Dialogs(xlDialogOpen).Show", mais cela oblige à selectionner un fichier dans le dossier.

Quelqu'un connaitrait il un moyen de pouvoir sélectionner un dossier et récupérer le chemin d'accès ?

Bonsoir

Sans le chemin d'accès, cela semble possible si j'en crois ce qui est écrit sur ce site pour chercher un fichier sur tout le disque dur.

Maintenant, je suis bien incapable d'y comprendre quelque chose..

Cordialement,

Amadéus

Salut Slayes, Amadéus et le forum

Une macro qui recherche le fichier si pas trouvé dans le répertoire.

Option Explicit
Option Compare Text

Sub Ouvrir_Classeur()

Dim wkb As Workbook
Dim repertoire As String
Dim fichier As String
Dim chemin As String
Dim Nbre As Byte

On Error GoTo Erreur

repertoire = "C:\"
fichier = "Couleur.xls"
chemin = repertoire & fichier

Set wkb = Application.Workbooks.Open(fichier)
' Set wkb = Nothing
Exit Sub

Recherche:
' Recherche du fichier
With Application.FileSearch
  .NewSearch
  .LookIn = "C:\"
  .FileType = msoFileTypeExcelWorkbooks
  .Filename = fichier
  .SearchSubFolders = True
  .Execute

    For Nbre = 1 To .FoundFiles.Count
      If Right(.FoundFiles(Nbre), Len(fichier) + 1) = "\" & fichier Then
        Set wkb = Application.Workbooks.Open(.FoundFiles(Nbre))
        ' Set wkb = Nothing
        Exit Sub
      End If
    Next Nbre

End With

Exit Sub

Erreur:

If Err = 1004 Then ' fichier introuvable
MsgBox "Le fichier " & fichier & " n'existe pas dans le dossier " _
& vbCrLf & repertoire & vbCrLf & "Une recherche va être éffectuée"
Resume Recherche
End If

End Sub

Mytå

Rechercher des sujets similaires à "macro selection dossier"