Editer lien hypertexte d'images [Résolu]

Signaler
Messages postés
5
Date d'inscription
jeudi 19 novembre 2020
Statut
Membre
Dernière intervention
19 novembre 2020
-
Messages postés
5
Date d'inscription
jeudi 19 novembre 2020
Statut
Membre
Dernière intervention
19 novembre 2020
-
bonjour,
j'ai une liste contenant des images dans des cellules et celles-ci ont un lien hypertexte vers des adresses de messagerie différentes.
j'aimerais afficher/éditer le lien de chacune en clair dans une autre cellule.
j'avoue ne pas trouver l'astuce.
merci

6 réponses

Messages postés
7059
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 novembre 2020
576
Messages postés
5
Date d'inscription
jeudi 19 novembre 2020
Statut
Membre
Dernière intervention
19 novembre 2020

Merci pour cette réponse rapide mais cela fonctionne pas avec des images.
ou alors je n'ai pas ciblé la bonne cellule:
pourtant mes images sont bien dans la colonne 1

Sub ExtractionLiensHypertextes()
Dim Cell As Range
On Error Resume Next
For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
Cell.Offset(0, 1) = Cell.Hyperlinks(1).Address
Next Cell
End Sub
Messages postés
7059
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 novembre 2020
576
Pour les images c'est différent.

Essaie ceci:

Option Explicit
Sub LireTexteShapes()
Dim i As Integer
Dim s As Shape
i = 1 'adapter la 1ère ligne
  For Each s In ActiveSheet.Shapes 'parcourt toutes les shapes(image)
     Range("B" & i).Value = s.Hyperlink.SubAddress
  i = i + 1
  Next s
End Sub



@+ Le Pivert


Messages postés
5
Date d'inscription
jeudi 19 novembre 2020
Statut
Membre
Dernière intervention
19 novembre 2020

Je ne connais pas du tout cette fonction shape !
il me pointe une erreur sur cette ligne:
Range("B" & i).Value = s.Hyperlink.SubAddress
Messages postés
7059
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 novembre 2020
576
essaie cela

Option Explicit
Sub Test()
    Dim shp As Shape, c As Range
    'On Error Resume Next
    With ActiveSheet
        For Each shp In .Shapes
            Set c = shp.BottomRightCell
            c.Offset(0, 0) = shp.Hyperlink.SubAddress
        Next shp
    End With
End Sub


pour en savoir plus sur les shapes

http://boisgontierjacques.free.fr/pages_site/lesimages.htm#CreationShape

@+
Messages postés
5
Date d'inscription
jeudi 19 novembre 2020
Statut
Membre
Dernière intervention
19 novembre 2020

merci pour le lien !
la petite macro ne fonctionne pas.
je vais essayer quelques lignes avec les shapes...
Messages postés
7059
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 novembre 2020
576
Pour des liens sur le web ou adresse sur le pc mettre ceci

Sub Test()
    Dim shp As Shape, c As Range
    'On Error Resume Next
    With ActiveSheet
        For Each shp In .Shapes
            Set c = shp.BottomRightCell
            c.Offset(0, 0) = shp.Hyperlink.Address
        Next shp
    End With
End Sub
Messages postés
5
Date d'inscription
jeudi 19 novembre 2020
Statut
Membre
Dernière intervention
19 novembre 2020

Merci
la formule fonctionne parfaitement. !
le codage est un peu au dessus de mon niveau mais le lien sur les shapes est vraiment intéressant.