VBA création de lien hypertexte

Version imprimable

24/11/2013, 19h24
Jynno22

VBA création de lien hypertexte

Bonsoir,

Voici une description de mon tableau:

Colonne 1 : Type
Colonne 2 : Marque
Colonne 3 : Modèle
Colonne 4 : Prix
Colonne 5 : Doc

Je suis bloqué sur cette dernière colonne, actuellement la case est rempli par un texte mais je voudrais que ce texte soit un lien hypertexte renvoyant vers une page web.

Ce qui me permettrais en cliquant sur Doc d'ouvrir une page web.

Par contre je suis un peu perdu pour la réalisation de cette fonction , le lien et le texte étant différent sur chaque ligne.
Comment faire pour saisir l'URL dans mon formulaire ainsi que mon texte correspondant à la colonne 5 et par la suite avoir un lien hypertexte (Texte+Lien) sur mon tableau?

Merci d'avance pour votre aide.

1 pièce(s) jointe(s)

Bonsoir,

Cf exemple en PJ

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
29
30
 
Private Sub UserForm_Initialize()
  With Sheets(1)
    Me.ListBox1.List = .Range("A2:C" & .Range("A65000").End(xlUp).Row).Value
  End With
End Sub
 
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ligne = Int(Y / (ListBox1.Font.Size * 1.18))
  If Y > 0.2 And Y <= ListBox1.Height - 3 And ligne < Me.ListBox1.ListCount Then
    Me.Lien.Visible = True
    Me.Adr.Visible = True
    Me.Lien.Caption = ListBox1.List(ligne + Me.ListBox1.TopIndex, 2)
    temp = Sheets(1).Cells(ligne + Me.ListBox1.TopIndex + 2, "c").Hyperlinks(1).Address
    Me.Adr.Caption = temp
    Me.ListBox1.ListIndex = ligne + Me.ListBox1.TopIndex
  Else
    Me.Lien.Visible = False
    Me.Adr.Visible = False
  End If
End Sub
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ligne = Me.ListBox1.ListIndex + 2
    temp = Sheets(1).Cells(ligne, "c").Hyperlinks(1).Address
    On Error Resume Next
    Err = 0
    ActiveWorkbook.FollowHyperlink Address:=temp, NewWindow:=True
    If Err <> 0 Then MsgBox "Erreur"
End Sub

Jacques Boisgontier

Bonsoir Jynno

Voici comment créer un lien basé sur l'enregistreur de macros.

Cordialement

Docmarti

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
29
30
Sub CreerLienHypertexte()
 
 
strUrl = "http://boisgontierjacques.free.fr/pages_site/formulairebases.htm"
strUrlText = "formulaire bases"
 
 
Set destCell = Cells(1, 5)
 
 
  If strUrlText <> "" Then
   destCell.Select
 
   ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strUrl, _
   TextToDisplay:=strUrlText
 
 
  End If
 
 
'Lire le lien 
 
 UrlLienORI = ""
  texteLienORI = ""
  On Error Resume Next
  UrlLienORI = destCell.Hyperlinks(1).Address
  texteLienORI = destCell.Hyperlinks(1).TextToDisplay
  On Error GoTo 0
 
End Sub

29/11/2013, 20h53
Jynno22

Désolé j'étais en déplacement avec comme seul équipement mon smartphone , merci pour vos réponses je regarde ça ce weekend.