Boite de dialogue 'Choix du Repertoire'

Baside

XLDnaute Impliqué

• 25 Avril 2005

• #2

Bonsoir Pascale, le Forum,

Ce code fait l'affaire, il faut cliquer sur 'configurer'

Sub CmdSelectionImprimante_Click()
Application.Dialogs(xlDialogPrinterSetup).Show
End Sub

Baside.

 

Vote positif 0 Vote négatif

P

Pascale

Guest

• 25 Avril 2005

• #3

Bonjour Baside, le forum,

Je te remercie pour ta promptitude, mais ce que je cherche c'est de choisir un repertoire pour copier mes dossiers et non pas de les imprimer.

@+

Pascale

 

Vote positif 0 Vote négatif

M

Moa

XLDnaute Occasionnel

• 25 Avril 2005

• #4

Salut Pascale :

Si tu copies tes fichiers toujours dans le même répertoire, tu as une solution :

Menu Outils/ Options / Onglet Général / Dossier par Défaut.

Sinon, tu sais que lorsque tu demandes l'enregistrement d'un fichier par macro, tu peux lui affecter un chemin .

@ +++

Moa

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 25 Avril 2005

• #5

bonjour Pascale , Baside et Moa

si tu as Excel 2002 tu peux tester

Sub choisirRepertoire()
Dim Dossier As FileDialog

Set Dossier = Application.FileDialog(msoFileDialogFolderPicker)
Dossier.Show

MsgBox Dossier.SelectedItems(1)
End Sub



bonne soiree
MichelXld

 

Vote positif 0 Vote négatif

Sylvain

XLDnaute Occasionnel

• 25 Avril 2005

• #6

bonsoir,

une autre solution :

Option Explicit

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
'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

Function GetDirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = 'Indiquez le répertoire à choisir'
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
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
'Appel a la procedure :
Sub répertoire_par_défaut()
Dim toto As String
Dim msg As String
msg = 'choix du répertoire par défaut'
toto = GetDirectory(msg)
If toto <> '' Then Range('a1').Value = toto + Application.PathSeparator
End Sub

Cliquez pour agrandir...

 

Vote positif 0 Vote négatif

G

galopin01

XLDnaute Occasionnel

• 25 Avril 2005

• #7

Bonsoir,
Pour rester sur la même idée que Michel il y a aussi :

Sub Test()
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Tout dépend de la finalité exacte.
A+

 

Vote positif 0 Vote négatif

P

Pascale

Guest

• 26 Avril 2005

• #8

Bonsoir ou Bonjour Moa, Sylvain, Michel,

Je vous remercie pour votre aide, que je n'est pas fini d'étudier. Mais j'ai oublier de préciser, évident que pour moi, que le fichier que je veux enregistrer n'est pas celui que j'utilise, mais figure dans une variable 'monfi'. Donc j'aurais voulu une boite de dialogue ou autre me permettant de choisir o&ugrave; enregistrer ce fichier.

Encore merci pour votre aide.

Pascale

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 26 Avril 2005

• #9

bonsoir à toutes et à tous

Pascale , peux tu detailler plus précisément ce que tu cherches à faire


bone soiree
MichelXld

 

Vote positif 0 Vote négatif

P

Pascale

Guest

• 27 Avril 2005

• #10

Bonjour Michel, à toutes et tous,

j'aurais voulu que par un click gauche sur une case ;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = '$N$23' Then
...

je puisse sélectionner un fichier quelconque dans un repertoire quelconque et le copier o&ugrave; je veux. Comme je l'ai dis plus haut, je pensais pouvoir y arriver avec une boite de dialogue,mais ce n'est pas le cas ou alors...

Merci de vouloir m'aider

Pascale

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 27 Avril 2005

• #11

bonsoir Pascale

j'espere que cet exemple pourra t'aider


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, Source As String
Dim objShell As Shell
Dim objFolder As Folder

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

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

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)
If (Not objFolder Is Nothing) Then objFolder.CopyHere (Source)

End If
End Sub

bonne soiree
MichelXld

 

Vote positif 0 Vote négatif

P

Pascale

Guest

• 27 Avril 2005

• #12

Bonsoir Michel

j'essaye ton code, mais il me crée une erreur a Dim ObjShell as Shell, il me met 'Type défini par l'utilisateur non défini'?

Ai je oubliée quelque chose?

Pascale

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 27 Avril 2005

• #13

rebonsoir Pascale

oui , tu n'as pas d'activé la reference Microsoft Shell controls And Automation , come cela est indiqué dans la macro


dans l'editeur de macros

Menu Outils
References
coches la ligne 'Microsoft Shell controls And Automation'
cliques sur OK pour valider


bonne soiree
MichelXld

 

Vote positif 0 Vote négatif

P

Pascale

Guest

• 27 Avril 2005

• #14

Re

Maintenant c'est:

If (Not objFolder Is Nothing) Then objFolder.CopyHere (Source)
CcopyHere qui me porte soucis

Car en fait, je n'es pas encore choisie de fichier à copier, ni le répertoire de destination.

A+ Michel

Pascale

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 28 Avril 2005

• #15

bonsoir Pascale

je ne sais quoi te dire puisque chez moi ça fonctionne ( Excel2002 & WinXP)

peux tu tester le fichier joint qui contient la procedure


bonne soiree
MichelXld [file name=copierFichier.zip size=8438]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/copierFichier.zip[/file]

 

Pièces jointes

• copierFichier.zip

  8.2 KB · Affichages: 75

Vote positif 0 Vote négatif