Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Excel VBA - Problème lien hypertexte pour ouvrir un dossier

Emma56320

XLDnaute Nouveau
Bonjour,
Je me permets de vous solliciter car j'ai un problème avec un programme que je ne parviens malheureusement pas à résoudre...
Je travaille à la direction du service social de mon Département.
J'ai créé un "moteur de recherche" grâce à un userform qui permet de trouver très facilement des documents dispatchés dans notre arborescence.
Mon responsable est très enthousiaste sur ce projet et me demande de présenter mon outil qui pour moi n'est pas encore abouti.
3 listes déroulantes en cascade permettent de sélectionner un document qui s'ouvre via un bouton de commande.
Le souci c'est que je parviens bien à ouvrir des fichiers (Excel, Word, PDF, ...) mais pas de dossiers (ex : un dossier nommé "rapports" où se trouvent plusieurs rapports Word).
J'ai beau tourner le problème dans tous les sens, je ne parviens pas à trouver la solution !
J'ai aussi essayer avec FollowHyperLink sur une autre version. Je crois que j'ai une piste car je suis parvenue à ouvrir un dossier mais les recherches sont aléatoires... (je sélectionne un document et c'est un autre document de la liste qui s'ouvre).
Je vous joins mon fichier.
Si quelqu'un aurait la gentillesse d'y jeter un coup d'œil et de m'aider à modifier mon programme, ça serait un réel soulagement !!!
Je vous remercie par avance !!!
Emma
 

Pièces jointes

  • OUTIL DE RECHERCHE TERRITOIRE.xlsm
    615 KB · Affichages: 9

Gégé-45550

XLDnaute Accro
Bonsoir,
essayez
VB:
Shell Environ("WINDIR") & "\explorer.exe " & Fichier, vbNormalFocus
Cordialement,
 

Emma56320

XLDnaute Nouveau
Bonsoir,
Je vous remercie pour votre retour.
Malheureusement, ça ne fonctionne pas... Ça ouvre uniquement l'explorateur de fichiers.
J'ai essayé avec :
ThisWorkbook.FollowHyperLink Address:=Range("D" & ComboBox3.ListIndex + 2)
Ça ouvre bien des fichiers et des dossiers comme je le souhaite mais il faut que la liste de mon tableau où se trouvent les liens soit dans l'ordre alphabétique (le même ordre que la liste de la ComboBox).
Et surtout, ça coince lorsque je modifie ma sélection de la ComboBox2 précédente forcément puisqu'il s'agit de listes en cascade !
Comment faire pour que lorsque je sélectionne le thème (ComboBox1 et colonne A de mon tableau), le lieu (ComboBox2 et colonne B) puis le document (ComboBox3 et colonne C), ça active le lien qui se trouve sur la ligne de mon tableau correspondant à ma selection dans la cellule de la colonne D ?
Le "ComboBox3.ListIndex" ne convient pas mais par quoi le remplacer ?
Je vous remercie d'avance pour votre aide !!!
Emma
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

L'instruction donnée par Gégé semble fonctionner.

Je te propose de mettre un \ en fin de chemin dans la colonne D de ta feuille "Liste", pour bien spécifier qu'il s'agit d'un dossier et non d'un simple fichier.

Après avoir mis les \ tu peux essayer ceci :
VB:
Private Sub BtnClic_Click()
'
    On Error Resume Next

    If Dir(Fichier) <> "" And Fichier <> "" Then

        If Right(Fichier, 1) = "\" Then
            Shell Environ("WINDIR") & "\explorer.exe " & Fichier, vbNormalFocus
            Exit Sub
        End If

        If Right(Fichier, 3) = "xls" Or Right(Fichier, 4) = "xlsm" Or Right(Fichier, 4) = "xlsx" Then
            Dim xl As Object
            Set xl = CreateObject("Excel.Application")
            xl.Workbooks.Open Filename:=Fichier
            xl.Visible = True
            Set xl = Nothing
            Exit Sub
        End If

        If Fichier Like "*http*" Then
            ActiveWorkbook.FollowHyperlink Fichier
        Else
            Dim MonApplication As Object
            Set MonApplication = CreateObject("Shell.Application")
            MonApplication.Open Fichier
            Set MonApplication = Nothing
        End If

    End If

End Sub
 

Emma56320

XLDnaute Nouveau
Bonsoir,
Oui c'est tout à fait ce que je souhaite faire : ouvrir la fenêtre de dialogue d'un dossier afin que je puisse choisir un fichier qui s'y trouve ! Désolée je m'étais sans doute mal exprimée...
Un grand merci pour ton aide !!!
 

TooFatBoy

XLDnaute Barbatruc
Dans ce cas, je te propose ceci, avec le bout de code qui ouvre la fenêtre de dialogue et que j'ai piqué là-bas :
VB:
Private Sub BtnClic_Click()
'
    On Error Resume Next

    If Dir(Fichier) <> "" And Fichier <> "" Then

        If Right(Fichier, 1) = "\" Then
            Dim fd As Office.FileDialog
            Dim strFichier As String
            Set fd = Application.FileDialog(msoFileDialogFilePicker)
            With fd
                .Filters.Clear
                .Filters.Add "Fichier", "*.*", 1
                .Title = "Choisissez un fichier"
                .AllowMultiSelect = False
                .InitialFileName = Fichier
                If .Show = True Then
                    strFichier = .SelectedItems(1)
                    If strFichier = "" Then Exit Sub
                    Fichier = strFichier
                End If
            End With
        End If

        If Right(Fichier, 3) = "xls" Or Right(Fichier, 4) = "xlsm" Or Right(Fichier, 4) = "xlsx" Then
            Dim xl As Object
            Set xl = CreateObject("Excel.Application")
            xl.Workbooks.Open Filename:=Fichier
            xl.Visible = True
            Set xl = Nothing
            Exit Sub
        End If

        If Fichier Like "*http*" Then
            ActiveWorkbook.FollowHyperlink Fichier
        Else
            Dim MonApplication As Object
            Set MonApplication = CreateObject("Shell.Application")
            MonApplication.Open Fichier
            Set MonApplication = Nothing
        End If

    End If

End Sub
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Désolé, je ne suis pas très doué, donc il manque des morceaux... ça ne peut pas fonctionner tel quel.


[edit]
J'ai un peu modifié la macro du message #7. J'espère qu'ainsi elle fonctionnera complètement.
Tu nous diras ça demain.
[/edit]
 
Dernière édition:

Emma56320

XLDnaute Nouveau
Bonjour TooFatBoy,
J'ai commencé par mettre un \ à la fin du chemin des dossiers et oh miracle, ça fonctionne !!!
Les codes que tu m'as proposés fonctionnent aussi ! Quand je pense que tu te dis pas doué... Bravo en tout cas !

Je vais abuser de tes compétences... J'ai un autre petit souci.
Lorsque j'ouvre mon outils si un fichier Excel était déjà ouvert, il disparait car j'ai dans WorkBook j'ai mis:
Private Sub WorkBook_Open()
Application.Visible = False
UserFormRecherche.Show
End Sub

Forcément on ne voit plus les fichiers mais uniquement mon userform puisque c'est ce que je demande...lol
Mais comment faire pour que ça n'agisse que sur mon fichier Recherche et non sur les autres fichiers déjà ouverts (en les réduisant simplement par exemple) ?

Merci par avance !!!

Emma
 

Gégé-45550

XLDnaute Accro
Bonjour TooFatBoy,
J'ai commencé par mettre un \ à la fin du chemin des dossiers et oh miracle, ça fonctionne !!!
Les codes que tu m'as proposés fonctionnent aussi ! Quand je pense que tu te dis pas doué... Bravo en tout cas !
TooFatBoy est trop modeste !
Bonjour Emma56320, salut l'ami TooFatBoy
Essayez de remplacer Application.Visible = False par ThisWorkBook.Visible=False
Cordialement,
 

Emma56320

XLDnaute Nouveau
Merci à tous les deux !
J'ai essayé votre suggestion Gégé en remplaçant Application par ThisWorkbook mais ça ne fonctionne pas malheureusement.
Erreur d'exécution 424
Objet requis
J'ai essayé avec Sheets.Visible = False mais
Erreur d'exécution 1004
Un classeur doit contenir au moins une feuille visible...
 

TooFatBoy

XLDnaute Barbatruc
Je n'ai pas bien saisi ce que tu veux faire, l'idéal étant bien évidemment de supprimer ce truc inutile, mais peut-être y a-t-il quelque chose à faire du côté de Workbook_Deactivate ???


Sinon, remplace
VB:
    Application.Visible = False
par
VB:
    Application.WindowState = xlMinimized
et dis-nous si ça fait ce que tu veux.

Ceci dit, vu que ton UserForm est préemptif, ça n'a pas grand intérêt.
 
Dernière édition:

Discussions similaires

Réponses
5
Affichages
504
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…