Discussion :

[p0m12]

Bonjour ou rebonjour ,

Le but est de recuperer un lien hypertext en A* a partir de A13, et de le mettre dans une forme (de style flèche pleine) la flèche est deja creer mais je peu la supprimer, pour que la macro recuperer le lien et creer une forme en F de X taille...
Pas facile tous sa, car je ne connais pas la variable de la forme et je ne c' est pas ou la trouver, j' ai chercher sur msdn mais bon y' en a plein...

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub ExtractionLiensHypertextes()
Dim Cell As Range
On Error Resume Next
For Each Cell In Range("A13:A" & Range("A65536").End(xlUp).Row)
'-----------------------------------------
' Mettre se lien hypertext dans une forme (Flèche droite à entaille) qui se 
' trouve en colone F
'-----------------------------------------
Next Cell
End Sub

[aalex_38]

Si je comprend bien ta flêche est un shape dessiné dans une feuille tu peux donc lui affecter un lien hypertext ou une macro.

Si les form se trouvent entièrement dans une cellule c'est plus simple

Edit : un exemple a adapter :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Inserrer_hyperlink_shape()
Dim i As Integer
Dim sh As Shape
 
For Each sh In ActiveSheet.Shapes ' .AddShape(msoShapeNotchedRightArrow, 72.75
If sh.Type = 1 Then 
    i = sh.TopLeftCell.Row
    sh.Select: ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(i, 6)
End If
 
Next
End Sub

[p0m12]

Bonjour, par la réponse a mon post, il s' avère que cela ne marche pas.
la macro reconnais bien la shape, mais met en info-bulle le lien de la feuiille.
Donc le probleme c'est que la macro ne récupère pas le lien qui se trouve en case A de la ligne.
PS: Je veux bien que vous me commenter le code car je voudrais aussi faire évoluer moi même mon programme.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Inserrer_hyperlink_shape()
Dim i As Integer
Dim sh As Shape
 
For Each sh In ActiveSheet.Shapes ' .AddShape(msoShapeNotchedRightArrow, 72.75
If sh.Type = 1 Then
    i = sh.TopLeftCell.Row
    sh.Select: ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(i, 6)
End If
 
Next
End Sub

[aalex_38]

Bonjour,

En fait il faut modifier mon code, il allait chercher en colonne 6 (F)

Remplace :

Code :

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

ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(i, 6)

Par

Code :

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

ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(i, 1)

Le code complet devient :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Inserrer_hyperlink_shape()
Dim i As Integer
Dim sh As Shape
 
For Each sh In ActiveSheet.Shapes  ' Boucle sur toutes les shapes de la feuille active
If sh.Type = 1 Then ' mes formes ont ce type donc je filtre la dessus, pour distinguer des graphiques par exemple, il y a peut être mieux
    i = sh.TopLeftCell.Row ' Determine la ligne (row) de la cellule en haut à gauche de la forme, comme ma forme est contenue dans une cellule, donne la cellule
    sh.Select: ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(i, 1) ' c'est la même chose que click droit, ajouter un lien hypertext, peut se faire avec l'enregistreur de macro
' Address:=Cells(i,1) => Lieu ou se trouve l'addresse a ajouter, ici sur la ligne de la forme en colonne A
End If
 
Next
End Sub

[p0m12]

Bonjour,
Suite a ton post qui me fais avancer a grand pas, je dirais que cette macro ne fais pas se que l' on veux,

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
Sub Inserrer_hyperlink_shape()
'Dim iform As Hyperlink
Dim iform As Integer
Dim sh As Shape
 
For Each sh In ActiveSheet.Shapes  ' Boucle sur toutes les shapes de la feuille active
If sh.Type = 1 Then ' mes formes ont ce type donc je filtre la dessus, pour distinguer des graphiques par exemple,
                    'il y a peut être mieux
    iform = sh.TopLeftCell.Row ' Determine la ligne (row) de la cellule en haut à gauche de la forme,
                           'comme ma forme est contenue dans une cellule, donne la cellule
    sh.Select: ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(iform, 1)
      ' c'est la même chose que click droit, ajouter un lien hypertext, peut se faire avec l'enregistreur de macro
      ' Address:=Cells(i,1) => Lieu ou se trouve l'addresse a ajouter, ici sur la ligne de la forme en colonne A
End If
 
Next
End Sub

PS: dans la colonne A a partir de 13 j' ai des liens hypertext, ses lien se présente comme ci: label de la case: google => lien hypertext: www.google.fr => info-bulle : ICI GOOGLE
Donc, le résultat de cette macro:
copie le label et le met dans la shape, dans l' info-bulle on retrouve le lien ou se trouve se fichier excel et le label de la case 1 de sa ligne.
--------------------------------------------------------------------
J' ai trouver une autre source mais je ne vois pas trop comment elle fonctionne:

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
Sub copierHypertextVERSForme()
Dim h As Hyperlink
Dim Ob As Shape
'récupération du lien hypertexte contenu dans
'la cellule A1 du classeur1
Set h = Worksheets(1).Range("A13").Hyperlinks(1)
'création de la forme
Set Ob = 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
End Sub

Le probleme de cette source ces que travaille avec plusieurs feuille et je ne c' es pas gérer sa, et je voudrais bien une petite explication pour se mot : "Worksheets".
Sinon la réponse a ce poste se trouve devant nos yeux, il doit être trop tôt je ne voie rien ...
Merci aux personnes qui se pencherons sur se probleme
Voici du travail ^^

[aalex_38]

je dirais que cette macro ne fais pas se que l' on veux

Encore faut-il que je le sache, je pensais que tu avais seulement un lien dans ta cellule.

Essai de remplacer

Code :

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

ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(iform, 1)

par :

Code :

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

ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(iform, 1).Hyperlinks(1).Address

Edit :

J' ai trouver une autre source mais je ne vois pas trop comment elle fonctionne

Le code me semble bien, ce sont les mêmes principes que ce que j'ai proposé, sauf que la création du shape se fait par le code, ce qui permet de récuppérer directement l'objet avec "Set Ob..." et d'y ajouter le lien avec "Anchor:=Ob..."