Récupération chemin répertoire en VBA

Résolu

Mistral_13200 Messages postés 649 Statut Membre -
Mistral_13200 Messages postés 649 Statut Membre - 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

Réponse 1 / 1
cs_Le Pivert Messages postés 8437 Statut Contributeur 730
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à
0
1. Mistral_13200 Messages postés 649 Statut Membre 4
  
  Bonjour Pivert,
  
  Je suis heureux de te retrouver et voir que tu as encore du temps à me consacrer.
  Je viens de tester ta proposition et ça fonctionne presque parfaitement. Je m’explique :
  - La récupération des différents chemins se fait parfaitement.
  - Le nom du répertoire recherché est toujours le même « Répertoire couleur » dans la fenêtre de recherche.
  
  chemin = ShellApp.BrowseForFolder(0, "REPERTOIR COULEUR !!!", 0).self.Path
  
  - Et là ou il y a problème c’est quand on clic sur annuler de la fenêtre "Recherche dossier" j’ai une erreur exécution 91.
  
  D’autre part il faudrait faire la même chose sur la colonne "F" et le mot "Destination" de manière à renseigner les cellules de "E3 à E6" avec le même chemin de répertoire.
  J’ai fusionné les cellules de "F3 à F6", que j’ai appelé "Destination". J’ai ensuite copié les trois premières lignes de la procédure Worksheet mais quand je fais un double clic sur "F3" il ne se passe rien.
  Si tu as une proposition, je suis preneur.
  Cordialement
  Mistral
  
  0
2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
  
  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
  
  0
3. Mistral_13200 Messages postés 649 Statut Membre 4
  
  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
  
  0
4. Mistral_13200 Messages postés 649 Statut Membre 4
  
  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
  
  0
5. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
  
  Voila la réponse à tes questions:
  
  https://www.cjoint.com/c/ILclbsSyoMQ
  
  @+ Le Pivert
  
  0

Récupération chemin répertoire en VBA

1 réponse

Discussions similaires

Newsletters