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

Réponse 1 / 6
Messages postés
7374
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mai 2021
 635
Bonjour,

en vba voir ce post

https://forums.commentcamarche.net/forum/affich-11888609-sos-excel
Réponse 2 / 6
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
Réponse 3 / 6
Messages postés
7374
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mai 2021
 635
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


Réponse 4 / 6
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
Signaler
Messages postés
7374
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mai 2021
 635
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

@+
Réponse 5 / 6
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...
Signaler
Messages postés
7374
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mai 2021
 635
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
Réponse 6 / 6
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.
Répondre Posez votre question