Hyperlien d'un tableau vers une listbox

[MeMa]

Bonjour,

Je crois après avoir fait le tour des forums ne pas avoir trouvé la solution à mon problème. Je compte sur vous!
J'ai récemment écrit un programme VBA qui permet de faire une recherche dans un tableur à partir de mots clefs. Autant dire que c'est un immense patchwork de bouts de codes que j'ai retrouvé sur des sites et d'autres.

Mon problème intervient lors de l'apparition de ma recherche dans une listbox, j'aimerai si possible afficher les liens de mon tableur dans ma listbox pour pouvoir directement y accéder. Or lorsque je sélectionne mon lien dans la listbox le programme plante et impossible d'aller plus loin. J'ai essayé plusieurs méthodes mais rien ne semble fonctionner.

J'espère que ma demande est faisable.

Ci-joint mon fichier excel (en format compressé parce que trop lourd) ce sera je pense plus explicite.

 

[job75]

Bonjour MeMa, bienvenue sur XLD,

Ce que vous entrez dans vos ListBoxes ce sont les textes des cellules, pas les adresses des liens.

Donc remplacez :

ListBox1.AddItem Cells(ligne, 7)

par :

ListBox1.AddItem Cells(ligne, 7).Hyperlinks(1).Address

Ensuite dans ListBox1_DblClick utilisez On Error Resume Next pour le cas où le lien n'aboutit pas.

Bonne journée.

 

[MeMa]

Bonjour MeMa, bienvenue sur XLD,

Ce que vous entrez dans vos ListBoxes ce sont les textes des cellules, pas les adresses des liens.

Donc remplacez :

ListBox1.AddItem Cells(ligne, 7)

par :

ListBox1.AddItem Cells(ligne, 7).Hyperlinks(1).Address

Ensuite dans ListBox1_DblClick utilisez On Error Resume Next pour le cas où le lien n'aboutit pas.

Bonne journée.

Bonjour,

Merci beaucoup! J'arrive pas à croire que la solution était si simple et j'avoue je m'en veux un peu. Ça fonctionne parfaitement et ça me sauve d'heures interminables de migraines.

Merci encore et bonne journée !

 

[BOISGONTIER]

Bonjour,

Quand on clique dans le ListBox, il faut pour activer le lien :

Private Sub ListBox1_Click()
  On Error Resume Next
  Err = 0
  ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(1), NewWindow:=True
If Err <> 0 Then MsgBox "Erreur"
End Sub

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormHyperLien.xls

Boisgontier

 

[MeMa]

Bonjour,

Quand on clique dans le ListBox, il faut pour activer le lien :

Private Sub ListBox1_Click()
  On Error Resume Next
  Err = 0
  ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(1), NewWindow:=True
If Err <> 0 Then MsgBox "Erreur"
End Sub

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormHyperLien.xls

Boisgontier

Bonjour Boisgontier,

Merci pour les réponses si rapide! Ça m'aide énormément et me fait gagner beaucoup de temps.

Merci et surtout bonne journée.

 

[MeMa]

Bonjour,

Quand on clique dans le ListBox, il faut pour activer le lien :

Private Sub ListBox1_Click()
  On Error Resume Next
  Err = 0
  ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(1), NewWindow:=True
If Err <> 0 Then MsgBox "Erreur"
End Sub

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormHyperLien.xls

Boisgontier

Re bonjour,

Je reviens vers vous encore une fois.

Même avec les corrections que vous avez apportés les liens ne fonctionnent pas. Il apparaissent dans ma listbox mais chaque fois que j'essaie d'en ouvrir un le programme me renvoie systématiquement vers la MsgBox d'erreur.

J'avoue être perdue et ne pas savoir quoi faire. J'ai bien vérifié et mes liens ne sont pas morts... Et le programme tourne parfaitement. J'ai aussi utilisé le programme que vous avez fourni mais je n'ai pas trouvé de problème.

Des suggestions?

 

[BOISGONTIER]

J'ai l'impression qu'il faut remplacer le 7 par 3

ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(3), NewWindow:=True

Pour le test:

Private Sub ListBox1_Click()
    On Error Resume Next
    Err = 0
    MsgBox Me.ListBox1.Column(3)
    ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(3), NewWindow:=True
    If Err <> 0 Then MsgBox "Erreur Fichier Introuvable"
End Sub

Boisgontier

 

[MeMa]

J'ai l'impression qu'il faut remplacer le 7 par 3

ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(3), NewWindow:=True

Pour le test:

Private Sub ListBox1_Click()
    On Error Resume Next
    Err = 0
    MsgBox Me.ListBox1.Column(3)
    ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(3), NewWindow:=True
    If Err <> 0 Then MsgBox "Erreur Fichier Introuvable"
End Sub

Boisgontier

Ça y'est c'est bon tout fonctionne. Merci encore pour votre patience et votre aide.

Bonne soirée!