Discussion :

[nicolas_151]

Recopier un lien Hypertexte d'une cellule vers un objet Shape ?

Bonjour Tous le monde

Voilà la situation :

Sur un classeur Excel j’ai une collection de lien hypertexte
Je voudrais les récupérer pour les mettres dans les formes que j’ai créé sur un autre classeur
Ces formes ne sont que des rectangles

Pour l’instant je me concentre sur une seule copie

Voilà le meilleur résultat que j’ai obtenue

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim clas1, clas2 As Excel.Workbook
Dim h As Excel.Hyperlink
Dim ob As Excel.Shape
 
‘selection des classeurs
Set clas1 = Workbooks(2)
Set clas2 = Workbooks(1)
 
‘ classeur  avec la forme
clas2.Worksheets("Feuil2").Activate
 
‘ récupération du lien hypertexte
Set h = clas1.Worksheets(1).Hyperlinks(1)
‘création de la forme
Set ob = Workbooks(1).Worksheets(2).Shapes.AddShape(msoShapeRectangle, 300, 300, 75, 25)
 
ob.TextFrame.Characters.Text = "Toto"
ob.TextFrame.HorizontalAlignment = xlVAlignCenter
 
 
 
‘ copie du lien dans la forme
With Worksheets(2)
    .Hyperlinks.Add Anchor:=ob, _
        Address:=h.Address, _
        ScreenTip:=h.ScreenTip, _
        TextToDisplay:=h.Range.Value
 
End With

Résultat
Le lien est créé mais n’ouvre pas le fichier : message « Impossible d’ouvrir le fichier spécifier »

De plus ce que je voudrais c’est de mettre le lien dans le texte de l’objet

Merci pour vos réponse

[SilkyRoad]

bonsoir

tu peux utiliser cette adaptation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim Clas1 As Workbook, Clas2 As Excel.Workbook
Dim h As Hyperlink
Dim Ob As Shape
 
'selection des classeurs
Set Clas1 = Workbooks("Classeur1")
Set Clas2 = Workbooks("Classeur2")
 
 
'récupération du lien hypertexte contenu dans
'la cellule A1 du classeur1
Set h = Clas1.Worksheets(1).Range("A1").Hyperlinks(1)
'création de la forme
Set Ob = Clas2.Worksheets(1).Shapes. _
    AddShape(msoShapeRectangle, 300, 300, 75, 25)
 
Ob.TextFrame.Characters.Text = h.Address
'Ob.TextFrame.HorizontalAlignment = xlVAlignCenter
 
'copie du lien dans la forme
Clas2.Worksheets(1).Hyperlinks.Add Anchor:=Ob, _
        Address:=h.Address

bon week end
michel

[nicolas_151]

Merci pour ta réponse

Ma principal erreur était, que mon classeur 2 n'était pas enregistrer au même endroit classeur 1
sa explique pourquoi le lien ne fonctionnait pas
j'ai rajouté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Ob.TextFrame.Characters.Font.Underline = xlUnderlineStyleSingle
Ob.TextFrame.Characters.Font.Color = RGB(10, 10, 255)

sur la création de ma forme
comme ca on n'a bien un hyperlien

encore merci