[XL-2003] Liens hypertextes dynamiques

Comme quoi on est jamais mieux servi que par soi meme...
un enorme merci a ceux qui ne m'ont pas aidé

j'ajoute la réponse pour ceux qui pourrais avoir un probleme similaire

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
31
32
33
34
35
36
37
38
39
40
41
42
Sub lien()
    Dim txt_lien As String
    Dim txt_onglet As String
    Dim currentrow As Integer
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
 
    ActiveCell.Select
    currentrow = ActiveCell.Row
    txt_lien = ActiveCell.Text
    txt_onglet = Left(txt_lien, 25)
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & txt_onglet & "'" & "!A1", TextToDisplay:=ActiveCell.Value
    Sheets("modele").Visible = True
    Sheets("modele").Select
    Sheets("modele").Copy After:=Sheets("modele")
    Sheets("modele (2)").Name = txt_onglet
 
    'Copie du texte
 
    Range("C4").Value = txt_lien
    Selection.Hyperlinks.Delete
    Range("C4").Font.ColorIndex = 10
    Range("C4").Font.Size = 12
    Range("C4").Font.Italic = True
    Range("C4").Font.Bold = True
    Sheets("liens").Activate
 
    'Ajout de la puce verte
 
    Range("A4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Cells(currentrow, 1).Select
    ActiveSheet.Paste
    Range("A4").Select
    Application.CutCopyMode = False
 
    Sheets("modele").Visible = False
    Sheets("liens").Activate
    ActiveCell.Select
 
End Sub