Récupération chemin répertoire en VBA [Résolu]

Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
- - Dernière réponse : Mistral_13200
Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
- 2 déc. 2019 à 14:16
Bonsoir à tous,

Il y a quelque temps, j’ai développé un classeur pour automatiser la création de diaporama. J’étais le seul à le faire pour plusieurs personnes. Aujourd’hui, on me demande de mettre ce classeur à disposition d’autres personnes.
Dans ce classeur les chemins des répertoires utilisés étaient en dur dans les macros. En le mettant à disposition, il ne fonctionne plus, car l’arborescence des différents ordinateurs n’est pas la même pour tout le monde.
Pour un bon fonctionnement, j’ai donc besoin de récupérer le chemin de 5 répertoires différents. J’ai cherché et j’ai trouvé une macro que j’ai adaptée. Voir mon classeur accessible avec ce lien :
https://www.cjoint.com/c/IKCr6FFpZsn

Ça fonctionne bien mais je n’arrive pas à faire en sorte qu’elle fonctionne pour les 5 répertoires.
Il faudrait que la fenêtre "Recherche de répertoire" s’ouvre 5 fois de suite avec un nom différent se trouvant colonne "B" pour ceux de la colonne "C" et "destination" pour celui de la colonne "E".

Pouvez-vous m’aider ?
D’avance merci
Mistral
Afficher la suite 

1 réponse

Messages postés
6410
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
2 décembre 2019
419
0
Merci
Bonjour,

Tu vas dans le module de ta feuille: Données

Voici le code qui se déclenchera au double clic dans la colonne B:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Value = "Couleur" Then
Choix_Dossier (Target.Row)
ElseIf Target.Value = "Nature" Then
Choix_Dossier (Target.Row)
ElseIf Target.Value = "Monochrome" Then
Choix_Dossier (Target.Row)
ElseIf Target.Value = "Thème" Then
Choix_Dossier (Target.Row)
End If
End If
End Sub
Sub Choix_Dossier(ByVal ligne As Integer)
 Dim ShellApp As Object
Dim chemin As String
 Set ShellApp = CreateObject("Shell.Application")
    chemin = ShellApp.BrowseForFolder(0, "Répertoire Couleur !!!", 0).self.Path
    Set ShellApp = Nothing
    Sheets("Données").Range("C" & ligne).Value = chemin
 End Sub




Tu supprimes ton module

voilà
cs_Le Pivert
Messages postés
6410
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
2 décembre 2019
419 -
Eviter de fusionner les cellules en vba!!!!!!!!!!

Si j'ai bien compris les chemins source et destination ne sont pas les mêmes. Donc on va ouvrir une 2ème boite de dialogue pour le répertoire de destination à la suite de celle pour le répertoire source

Comme ceci:

Option Explicit
 Dim ShellApp As Object
Dim chemin As String
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Value = "Couleur" Then
Choix_Dossier (Target.Row)
Choix_Dossierdestination (Target.Row)
ElseIf Target.Value = "Nature" Then
Choix_Dossier (Target.Row) 'source
Choix_Dossierdestination (Target.Row) 'destination
ElseIf Target.Value = "Monochrome" Then
Choix_Dossier (Target.Row)
Choix_Dossierdestination (Target.Row)
ElseIf Target.Value = "Thème" Then
Choix_Dossier (Target.Row)
Choix_Dossierdestination (Target.Row)
End If
End If
End Sub
'répertoire source
Sub Choix_Dossier(ByVal ligne As Integer)
 On Error Resume Next 'évite le bug si pas renseigné
 Set ShellApp = CreateObject("Shell.Application")
    chemin = ShellApp.BrowseForFolder(0, "Choisissez votre Répertoire Source", 0).self.Path
    Set ShellApp = Nothing
    Sheets("Données").Range("C" & ligne).Value = chemin
 End Sub
'répertoire destination
Sub Choix_Dossierdestination(ByVal ligne As Integer)
 On Error Resume Next
 Set ShellApp = CreateObject("Shell.Application")
    chemin = ShellApp.BrowseForFolder(0, "Choisissez votre Répertoire Destination", 0).self.Path
    Set ShellApp = Nothing
    Sheets("Données").Range("E" & ligne).Value = chemin
 End Sub



voilà

@+ Le Pivert
Mistral_13200
Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
3 -
Merci pour ta réponse mais je ne suis pas disponible ce W.E.
Je reviens vers toi, si tu le permet, lundi quand j'aurais testé ta seconde proposition.
Bon W.E à toi
Cordialement
Mistral
Mistral_13200
Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
3 -
Bonsoir Pivert,

Mon W.E est tombé à l’eau, au propre comme au figuré, alors je me suis penché sur ta deuxième proposition.

Elle fonctionne bien mais en testant je me suis rendu compet que l’onglet "Données" sera une feuille masquée et protégée. La procédure Worksheet ne peut donc pas se trouver sur cette feuille. J’ai donc adapté ta proposition à ce que sera l’onglet "Menu" au final. Cela fonctionne plutôt bien, mais je te laisse vérifier ce que j’ai fait car mes connaissances sont limitées. Ci-dessous le lien pour télécharger mon fichier :
https://www.cjoint.com/c/ILbriSdXOGn

Cependant j’ai encore quelques problèmes que je n’arrive pas à régler :
- Comment écrire, en VBA, dans une feuille protégée par P.W sans avoir ce dernier lisible dans la procédure ?
- Peut-on rendre un code VBA invisible ?
- Comment quitter Excel sans sauvegarder et sans message un classeur ?

Merci d’avance pour ton aide.
Cordialement.
Mistral
cs_Le Pivert
Messages postés
6410
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
2 décembre 2019
419 -
Voila la réponse à tes questions:

https://www.cjoint.com/c/ILclbsSyoMQ


@+ Le Pivert
Mistral_13200
Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
3 -
Bonjour Pivert,

C'est tout bon je suis arrivé à mes fins.
Mille mercis à toi.
Je ferme le post.

Cordialement.
Mistral
Commenter la réponse de cs_Le Pivert