Ouvrir l'explorateur dans un dossier spécifique

Bonsoir le forum,

Je cherche un moyen d'ouvrir l'explorateur dans le chemin inscrit en A1

J'ai ce code qui provient d'une procédure plus complexe:

 ChDir "C:\"

Par quoi dois-je le remplacer pour qu'il s'ouvre au chemin contenu en A1 (une procédure plus longue y récupère ensuite un fichier et fait son boulot...?

Merci de votre aide^^

avec kl'enregistreur de macro j'ai eu ceci

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 02/05/2010 par jm
'

'
    Range("A1").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub

en A1 tu mets un lienhypertexte vers le répertoire que tu veux ouvrir

Bonjour,

Peux-tu me donner un exemple du chemin exact qui se trouve en A1 ?

Sinon un code à essayer si le chemin complet se trouve en A1

Dim chemin As String
chemin = Range("A1")
Shell "explorer /e,,chemin"", vbMaximizedFocus"

Amicalement

Salut Dan, jmd et merci de vos réponses...

En effet, j'avais déjà essayer les méthodes shell et follow hyperlink mais elles ouvrent le fichier.

Peut-être n'ai-je d'ailleur pas été assez précis à ce sujet. Le code permet d'importer les donner d'un autre fichier dans le fichier ouvert mais ne le laisse pas ouvert.

Voici le code complet:

Sub import()
'Définition des variables
 Dim a As Variant, Nom As String
'Désactivation des alertes
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
'ouverture de l'explorateur
    Nom = ActiveWorkbook.Name
    ChDrive "C:"    ' Choix du lecteur
    ChDir "C:\"    'Choix du répertoire
    a = Application.GetOpenFilename

    Typefichier = ("fichier excel (*.xls), *.xls,")

    Titre = "Quelle résevation voulez-vous ouvrir?"

    Select Case TypeName(a)
    Case Is = "Boolean"
        Exit Sub
    Case Else

            Workbooks.Open a

    End Select

    Nom2 = ActiveWorkbook.Name
    Sheets("BADO").Select
    Cells.Select
       Application.CutCopyMode = False
        Selection.Copy
    Windows(Nom).Activate
    Sheets("BADO").Range("a1").Select
     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

      Windows(Nom2).Activate
    Sheets("cotation").Select
    Cells.Select
       Application.CutCopyMode = False
        Selection.Copy
    Windows(Nom).Activate
    Sheets(2).Range("a1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

    Windows(Nom2).Close
    Application.DisplayAlerts = True
End Sub

Ce que je voudrait, c'est que l'explorateur s'ouvre directement dans le dossier spécifié en A1 et non dans C.

Avez vous d'autres idées??

Merci d'avance,

Bonjour,

peut-être que ce post pourrait t'aider

Liens

Merci à tous de votre aide...

J'ai trouvé la solution. J'avais déjà essayé cette méthode mais ça ne fonctionnat pas... normal, mon fichier étaiy sur un disc amovible... et dire que j'ai mis tout ce temps à m'enrendre compte

Voici donc le code qui me permet d'importer les données des feuilles BADO et Cotation en ouvrant 'explorateur dans le fichier dont le chemin est renseigné en A1... Peut-être que ça servira à quelqu'un^^

Sub import()
'Définition des variables
 Dim a As Variant, Nom As String
'Désactivation des alertes
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
'ouverture de l'explorateur
    Nom = ActiveWorkbook.Name

    ChDir Sheets("BADO").Range("A1")    'Choix du répertoire
    a = Application.GetOpenFilename

    Typefichier = ("fichier excel (*.xls), *.xls,")

    Titre = "Quelle résevation voulez-vous ouvrir?"

    Select Case TypeName(a)
    Case Is = "Boolean"
        Exit Sub
    Case Else

            Workbooks.Open a

    End Select

    Nom2 = ActiveWorkbook.Name
    Sheets("BADO").Select
    Cells.Select
       Application.CutCopyMode = False
        Selection.Copy
    Windows(Nom).Activate
    Sheets("BADO").Range("a1").Select
     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

      Windows(Nom2).Activate
    Sheets("cotation").Select
    Cells.Select
       Application.CutCopyMode = False
        Selection.Copy
    Windows(Nom).Activate
    Sheets(2).Range("a1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

    Windows(Nom2).Close
    Application.DisplayAlerts = True
End Sub

Merci encore de votre aide

A bientôt

Re,

Si ta demande est solutionnée, oublie pas de cliquer sur le V en vert pour cloturer le fil.

Amicalement