Boite de dialogue 'Choix du Repertoire'

[Pascale]

Bonjour à toutes et à tous,

j'aimerais faire appel à la boite de dialogue 'Choix du Repertoire', comme Application.Dialogs(xlDialogPrint).show pour l'imprimante,
deWindow, mais je ne connais pas le nom.

Est ce quelqu'un pourait me le donner,s'il vous plait?

Merci et bon après midi.

Pascale

 

[Pascale]

Bonsoir Michel

ok ça fonctionne merci, mais comment faire pour copier plusieurs fichiers(Sélection multiple).

A+

Pascale

 

[MichelXld]

bonjour Pascale

ci joint une adaptation pour les mutiselections

Option Base 1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'necessite d'activer la reference Microsoft Shell controls And Automation
Dim Dossier As FileDialog, Fichier As FileDialog
Dim Destination As String
Dim Source() As String
Dim objShell As Shell
Dim objFolder As Folder
Dim i As Byte

If Target.Address = '$N$23' Then

Set Fichier = Application.FileDialog(msoFileDialogOpen)
Fichier.Show
If Fichier.SelectedItems.Count = 0 Then Exit Sub

For i = 1 To Fichier.SelectedItems.Count
ReDim Preserve Source(i)
Source(i) = Fichier.SelectedItems(i)
Next i

Set Dossier = Application.FileDialog(msoFileDialogFolderPicker)
Dossier.Show
If Dossier.SelectedItems.Count = 0 Then Exit Sub
Destination = Dossier.SelectedItems(1)

Set objShell = New Shell
Set objFolder = objShell.NameSpace(Destination)

For i = 1 To UBound(Source())
If Not objFolder Is Nothing Then objFolder.CopyHere (Source(i))
Next i

End If
End Sub

bon week end
MichelXld

 

[Pascale]

Bonjour Michel,le forum,

C'est vraiment super ce que tu as fait, c'est ce que je cherchais à faire de mon coté sans y arriver.seul petit accros, c'est que cele fonctonne bien quand le programme est seul, mais qand il est dans un ensemble il me sort une erreur 'Membre de Methode ou de donnée introuvable' a cet endroit .CopyHere. Dans ton code précédent pour 1 seule sélection c'était la même chose ?

Désolée pour ce contre temps, merci pour m'aider encore sur ce point.

Bonne soirée.

Pascale

 

[MichelXld]

bonjour Pascale

je ne comprends pas bien ton dernier soucis , mais tu peux tester cette autre methode

Option Base 1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dossier As FileDialog, Fichier As FileDialog
Dim Destination As String
Dim Source() As String
Dim Fso As Object
Dim i As Byte

If Target.Address = '$N$23' Then

Set Fichier = Application.FileDialog(msoFileDialogOpen)
Fichier.Show
If Fichier.SelectedItems.Count = 0 Then Exit Sub

For i = 1 To Fichier.SelectedItems.Count
ReDim Preserve Source(i)
Source(i) = Fichier.SelectedItems(i)
Next i

Set Dossier = Application.FileDialog(msoFileDialogFolderPicker)
Dossier.Show
If Dossier.SelectedItems.Count = 0 Then Exit Sub
Destination = Dossier.SelectedItems(1) & '\\'


Set Fso = CreateObject('Scripting.FileSystemObject')

For i = 1 To UBound(Source())
'False pour ne pas ecraser les fichiers existants portant le meme nom
Fso.CopyFile Source(i), Destination, False
Next i

End If
End Sub

bon dimanche
MichelXld

 

[Pascale]

Bonjour Michel, le Forum,

Ce que je disais c'était que si je faisait:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = '$N$23' Then
Call copier
End If
End Sub
Private Sub copier()
'ton code'
End sub

j'avais une erreur à .CopyHere

Désolé donc pour ce petit travail dominical, mais ce que tu as fait marche super. Pourquoi un tel soucis sur le code précédant ?

A+ et bon Dimanche.

Pascale