Récupération chemin répertoire en VBA

Résolu/Fermé

Mistral_13200 Messages postés 636 Date d'inscription mardi 5 août 2008 Statut Membre Dernière intervention 15 novembre 2024 - 28 nov. 2019 à 19:10
Mistral_13200 Messages postés 636 Date d'inscription mardi 5 août 2008 Statut Membre Dernière intervention 15 novembre 2024 - 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

A voir également:

Récupération chemin répertoire en VBA
Répertoire téléphonique gratuit - Télécharger - Bureautique
Convertisseur récupération de texte - Guide
Recuperation video youtube - Guide
Mon répertoire - Forum Samsung
Recuperation compte gmail - Guide

1 réponse

Réponse 1 / 1

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
28 nov. 2019 à 19:57

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à

Mistral_13200 Messages postés 636 Date d'inscription mardi 5 août 2008 Statut Membre Dernière intervention 15 novembre 2024 4
29 nov. 2019 à 09:00

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

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié le 29 nov. 2019 à 11:34

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 636 Date d'inscription mardi 5 août 2008 Statut Membre Dernière intervention 15 novembre 2024 4
29 nov. 2019 à 16:13

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 636 Date d'inscription mardi 5 août 2008 Statut Membre Dernière intervention 15 novembre 2024 4
1 déc. 2019 à 18:27

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 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
2 déc. 2019 à 12:02

Voila la réponse à tes questions:

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

@+ Le Pivert

Discussions similaires

ouverture d'un fichier excel à partir d'un code VBA

"L'indice n'appartient à la sélection" + VBA

chemin unc

Erreur d'exécution 13 Incompatibilité de type

High Sierra : refus de réinstallation "serveur pas contacté"