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

Question

Posez votre question Signaler

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

Mistral_13200

Messages postés: 511
Date d'inscription: mardi 5 août 2008
Statut: Membre
Dernière intervention: 2 décembre 2019

- 28 nov. 2019 à 19:10 - 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

Excel Posez votre question Signaler

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

A voir également:

1 réponse

Répondre Posez votre question

cs_Le Pivert · Answer 1 · 2019-11-28T19:57:25+0100

Signaler Commenter la réponse de cs_Le Pivert

cs_Le Pivert

Messages postés: 6410
Date d'inscription: jeudi 13 septembre 2007
Statut: Contributeur
Dernière intervention: 2 décembre 2019

419 28 nov. 2019 à 19:57

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à

Afficher les 6 commentaires

Signaler Commenter la réponse de Mistral_13200

Mistral_13200

Messages postés: 511
Date d'inscription: mardi 5 août 2008
Statut: Membre
Dernière intervention: 2 décembre 2019

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

Signaler Commenter la réponse de cs_Le Pivert

cs_Le Pivert

Messages postés: 6410
Date d'inscription: jeudi 13 septembre 2007
Statut: Contributeur
Dernière intervention: 2 décembre 2019

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

Signaler Commenter la réponse de Mistral_13200

Mistral_13200

Messages postés: 511
Date d'inscription: mardi 5 août 2008
Statut: Membre
Dernière intervention: 2 décembre 2019

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

Signaler Commenter la réponse de Mistral_13200

Mistral_13200

Messages postés: 511
Date d'inscription: mardi 5 août 2008
Statut: Membre
Dernière intervention: 2 décembre 2019

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

Signaler Commenter la réponse de cs_Le Pivert

cs_Le Pivert

Messages postés: 6410
Date d'inscription: jeudi 13 septembre 2007
Statut: Contributeur
Dernière intervention: 2 décembre 2019

419 - 2 déc. 2019 à 12:02

Voila la réponse à tes questions:

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

@+ Le Pivert

Signaler Commenter la réponse de Mistral_13200

Mistral_13200

Messages postés: 511
Date d'inscription: mardi 5 août 2008
Statut: Membre
Dernière intervention: 2 décembre 2019

3 - 2 déc. 2019 à 14:16

Bonjour Pivert,

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

Cordialement.
Mistral

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

1 réponse

Votre réponse

Speccy

Greenshot

The Gimp

SyncBack

MKVtoolnix

Vivaldi

Hiren's BootCD