bouton pour ouvrir lien hypertext [Résolu]

[kbj_ihma]

Bonsoir,

J'ai réalisé un userform qui s'ouvre en cliquant sur les cellules d'une colonne, et j'ai mis à l'intérieur de ce userform un bouton pour ouvrir le fichier correpondant.

En fait, j'ai mis les liens hypertext dans la cellule qui se trouve juste à droite de celle qui est active.

et mon but est qu'en cliquant sur le bouton pour ouvrir le fichier voulu :
si le lien fonctionne : le fichier s'ouvre.
si le lien n'existe pas (donc cellule vide) : avoir un message qui dit : le lien n'existe pas
si le lien ne fonctionne pas : avoir un message qui dit : le lien ne marche pas, veuillez contacter l'administrateur pour le corriger.

et le code que j'ai écrit est celui ci :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
'Pour ouvrir le document (par son lien hypertexte
Private Sub CommandButton1_Click()
Dim Cible As String
 
  'Pour selectionner la cellule à la droite de la cellule active
  ActiveCell.Offset(0, 1).Select
 
 
        'Vérifie si la cellule contient un lien hypertexte
       If ActiveCell.Hyperlinks.Count = 0 Then
       MsgBox "Pas de lien !"
  Else
 'Extrait l'adresse du lien
Cible = ActiveCell.Hyperlinks(1).Address
 'Vérifie si le fichier existe.
 'Si oui exécute l'ouverture du fichier sur lequel pointe le lien
If Dir(Cible) <> "" Then
Selection.Hyperlinks(1).Follow NewWindow:=True
 ' Si non ouverture du MsgBox fichier introuvable
Else
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Cellule.Hyperlinks(1).Follow NewWindow:=True
 'MsgBox "Fichier introuvable"
End If
End If
'Cellule.Hyperlinks(1).Follow NewWindow:=True
'Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub

Malheureusement, ca ne marche pas tout à fait, quand le lien ne fonctionne pas surtout.
Pouvez vous m'aider s'il vous plait;
Merci d'avance

[ZebreLoup]

Pourquoi ton msgbox est en commentaire et que tu cherches quand même à ouvrir le lien si tu as vérifié que le fichier n'existait pas ?

Une autre question, pourquoi est-tu passée par un userForm ?

[kbj_ihma]

Bonsoir,
merci pour ta réponse,
En fait, la problématique que je rencontre fait partie d'un projet plus large que je suis en train de réaliser.
Dans mon document, j'ai une colonne où les différents documents types sont listés. et donc mon userform permet à chaque fois que je clique sur l'un des documents, il m'affiche là dedans une photo spécifique, avec la possibilité d'ouvrir ce document.
Donc le souci que j'ai c'est lorsque le lien ne marche pas, je veux qu'il y ait un message pour aleter les utilisateurs.
et pour les commentaires, il faut pas trop en tenir compte, je suis pas forte en VB, donc je teste des choses, et quand ca marche pas je les met en commentaire, pour ne pas les perdre et retester plus tard;

[ZebreLoup]

Voilà ce que je te conseille :
Dans le code de la feuille dans laquelle tu sélectionnes tes cellules (à mélanger sans doute avec ce que tu fais déjà) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
'Sur le changement de selection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 Then 'Sur la première colonne
        If Target.Value <> "" Then 'Si on a un fichier
            Dim cible As String
 
            If Target.Offset(0, 1).Hyperlinks.Count = 0 Then
                cible = ""
            Else
                cible = Target.Offset(0, 1).Hyperlinks(1).Address
            End If
 
            UserForm1.cible = cible
            UserForm1.Show
        End If
    End If
End Sub

Dans le code du userForm :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
'Je te conseille de mettre la cible comme une propriété du UserForm
' et de la renseigner juste avant de faire TonUserForm.Show sur le clique de la cellule
Public cible As String
 
'Pour ouvrir le document (par son lien hypertexte
Private Sub CommandButton1_Click()
    'Si pas de lien hypertexte
    If cible = "" Then
        MsgBox "Pas de lien !"
    Else
        Dim fso As New FileSystemObject 'Microsoft scripting runtime doit être coché
 
        If Not fso.FileExists(cible) Then
            MsgBox "Fichier introuvable"
        Else
            ThisWorkbook.FollowHyperlink cible
        End If
    End If
End Sub

Je pense qu'il est important que ta cible soit un paramètre du userForm. Utiliser la cellule active peut provoquer des erreurs plus facilement.

[kbj_ihma]

bonjour,

Je suis désolée mais je n'arrive pas à comprendre comment corriger mon code.

Si ca te gène pas, je te joint mon document, si tu peux jeter un coup d'oeil.

Merci d'avance

[ZebreLoup]

J'ai mis le code que je t'avais donné dans ton fichier, en adaptant un peu tu verras. Ca a l'air de faire à peu près ce que tu veux. Tu me diras.

[kbj_ihma]

bonsoir,
Merci beaucoup pour ton aide. c'est exactement ce que je voulais.
Tu me l'as bien corrigé, car maintenant en cliquant sur une cellule vide ma userform ne se lance plus betement.
Y a juste quelque chose que j'ai remarqué, quand je veux ouvrir un fichier dont le lien marche bien, j'ai un message de sécurité qui me dit :
Ouverture de c:...........(chemin du fichier)
Les Liens hypertexte peuvent endommager votre ordinateur et vos données. Pour protéger votre ordinateur, ouvrez uniquement les liens hypertexte de sources fiables. Voulez vous continuer?

En cliquant sur oui, le fichier s'ouvre bien. Mais c'est vrai que c'est un message qui inquiète un peu. Tu crois qu'il y a un moyen de le supprimer?
Encore merci beaucoup pour ton aide

heuuu, y a un truc bizarre qui se produit,
J'ai rajouté d'autres noms de fichier avec des liens qui marchent bien mais quand quand j'essaye de les ouvrir,
j'ai du coup, tout le temps, le message qui dit que le fichier est introuvable.

c'est peu etre lié au message de sécurité ?!

[ZebreLoup]

Pour le problème du message d'alerte, tu peux faire

Code :

Application.DisplayAlerts = False

avant l'ouverture et le remettre à True après.

Pour le problème des fichiers introuvables, je pense que le problème vient du fait que tu as du entrer une adresse "relative" pour ton hyperlien. Le code ne récupère du coup que le nom du fichier et pas le chemin complet.

Essaie en rentrant le chemin complet dans ton hyperlien.

Question bête : pourquoi tu ne laisses pas l'utilisateur cliquer directement sur l'hyperlien ou alors que tu ne rentres pas seulement le chemin du fichier en colonne C ?
EDIT : Tu veux afficher l'image, donc je comprends que tu ne laisses pas l'utilisateur cliquer sur l'hyperlien. Mais pourquoi tu ne rentres pas l'adresse directement ?

[kbj_ihma]

C'est que je trouve plus pratique que lors du clic, la userform puisse proposer l'apercu et la possibilité d'ouvrir le document.
J'ai mis le lien sur la case à droite, car si je met le lien sur la case qui contient le nom des documents et je clic les fichiers s'ouvrent directement au lieu d'ouvrir la userform.
Je voyais que cette solution.

[ZebreLoup]

Oui, mais vu que tu n'utilises pas le lien en tant que tel, pour ne pas que l'utilisateur pense qu'il doit cliquer dessus, tu pourrais juste entrer le chemin du fichier. Ce serait plus simple à gérer. Et tu pourrais d'ailleurs masquer la colonne si tu ne veux pas que l'utilisateur voit ce chemin.

[kbj_ihma]

C'est ce que je croyais faire en mettant les lien hypertexte dans la colonne à droite et j'avais l'intention de masquer la colonne.
Mais toi, tu me proposes visiblement autre chose mais je ne comprend pas ce que c'est, désolée.

[ZebreLoup]

Juste écrire C:\chemin\chemin\fichier.pdf dans la cellule

[kbj_ihma]

Je viens de réassyer comme tu m'as dit, çà à l'air de marcher.
JE vais faire plusieur test avant de crier victoire!
Merci beaucoup.

[ZebreLoup]

Forcément, il faut adapter un peu le code. Mais c'est plus facile de prendre la valeur de la cellule que d'aller voir s'il y a un hyperlien et de récupérer sa cible.

[kbj_ihma]

Bonjour,
C'est moi à nouveau. J'ai une question s'il te plait.
si par exemple je note un chemin dans une cellule, c:hjj\gfdh\fichier.doc
mais que je ne l'insère pas en temps que lien hypertexte
est ce qu'il moyen de le lancer en vba

J'ai pensé à quelque chose comme ca :

Code :

1
2
Application.DisplayAlerts = False
Workbooks.Open Filename:=ActiveCell.Value

c'est pour éviter les erreurs.
Car les liens que je vais enregistrer dans mon document excel, sont très nombreux et parfois c'est sur un autre serveur. et comme y aura beaucoup de monde qui utiliseront ce document. Je n'ai pas envie que çà plante sur leur poste.
Merci d'avance

[ZebreLoup]

Oui tu peux le lancer en VBA, c'est justement ce que je te conseillais et que j'avais mis dans le code que je t'ai proposé plus haut :

Code :

ThisWorkbook.FollowHyperlink cible

Workbooks.Open ne marchera que pour des fichiers Excel.

[kbj_ihma]

D'après ce que j'ai compris dans le document corrigé que tu m'a envoyé,
dans la feuille sur laquelle je travaille, t'as demandé à ce que le lien hypertexte s'enregistre en cible, après dans le code du clic du boutton dans la userform, t'as demandé à lancer la cible.
Moi je me demandais si on pourrai faire pareil mais en mettant le lien juste dans la cellule, sans l'inserer avec "clic droit, lien hypertexte). on va le marquer comme du texte.
donc l'idée c'est de modifier

Code :

forming.cible = Target.Offset(0, 1).Hyperlinks(1).Address

et si c'est possible de demander à ce que la valeur de la cellule (toujours qui se place juste à droite) s'enregistre en cible.
Peu etre que de cette façon, le problème des liens relatifs et absolus disparaitra.

[ZebreLoup]

Exactement, et comme tu t'en doutes

Code :

forming.cible = Target.Offset(0, 1).Hyperlinks(1).Address

devient tout simplement

Code :

forming.cible = Target.Offset(0, 1).Value

Et bien sûr toujours dans le Worksheet_SelectionChange

Code :

If Target.Offset(0, 1).Hyperlinks.Count = 0 Then

Devient

Code :

If Target.Offset(0, 1).Value = "" Then

[kbj_ihma]

Cooool, t'es génial.
C'est enfin monté à mon cerveau!
J'ai tout corrigé : Ca devrait maintenant ne plus causer de problèmes.
Merci beucoup.
A bientôt pour de nouvelles aventures.

[kbj_ihma]

bonsoir ZebreLoup,
Déjà de retour ...
En fait, j'ai repéré un bug;
Quand je selectionne plusieurs cellules, en même temps, de la colonne où se trouve ma liste de documents, j'ai un bug.
je pense que c'est du au fait qu'il n'y a pas ce cas : de selection multiple.
Donc j'ai rajouté dans la feuille 1 juste après :

Code :

If Not Intersect(Target, Me.Range("B2:B20")) Is Nothing Then

J'ai rajouté çà :

Code :

1
2
3
If Target.Count > 1 Then
Exit Sub
End If

Ca semble marcher.
Bonne soirée