Discussion :

[Oh!Tofocus]

Salut a tous.
Existe-t-il une application du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

reponse = Application.GetOpenFilename

qui permet de choisir un dossier et de récupérer son chemin ?

Du style de la fenêtre qui s'affiche quand on télécharge un fichier joint et que Outlook Express nous demande dans quel dossier le copier.

[da991319]

Bonjour, il me semble que Application.GetOpenFilename fait exactement ca non?

[fred65200]

Bonsoir, j'utilise cette macro pour ouvrir un devis, à toi de l'adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Sub OuvrirDevis()
Dim fd As FileDialog
Dim Devis As Variant
 
Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
With fd
  .InitialFileName = Racine & "Devis\MAQUETTE.xlsm"
  .ButtonName = "Ouvrir ce(s) devis"
  .InitialView = msoFileDialogViewDetails
  .Title = "Quel devis?"
  .Filters.Add "Devis XX XXX", "*.xlsm", 1
  .AllowMultiSelect = True
 
  If .Show = -1 Then
    NoDev = "####*-######-[A-Z][A-Z].xlsm"
    For Each Devis In .SelectedItems
      MonChoix = Right(Devis, InStr(1, StrReverse(Devis), "\") - 1)
      If MonChoix Like NoDev Or _
      MonChoix = "MAQUETTE.xlsm" Then
        If Not DejaOuvert(CStr(Devis)) Then
          Workbooks.Open(Filename:=Devis, AddToMRU:=True).RunAutoMacros Which:=xlAutoOpen
        Else
          Workbooks(MonChoix).Activate
        End If
      Else
        MsgBox MonChoix & vbLf & "n'est pas un devis!": OuvrirDevis
      End If
    Next Devis
  Else:        End
  End If
End With
Set fd = Nothing
End Sub
 
'la fonction qui va avec le code
Function DejaOuvert(CheminComplet$) As Boolean
Dim Wbk As Workbook
On Error Resume Next
Set Wbk = Workbooks(Dir$(CheminComplet))
DejaOuvert = Err = 0
Err.Clear
End Function

Salutations

[da991319]

OUPS desole j'avais mal lu la question

[SilkyRoad]

bonjour


Une autre possibilité

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub ChoixRepertoire()
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
 
    MsgBox Chemin
End Sub

bonne journée
michel

[Oh!Tofocus]

Merci à tous pour vos reponses rapides
Je retiens celle de SilkyRoad
Trés compacte elle correspond exactement à ce que je cherche.