Editer lien hypertexte d'images

Résolu
Onepat1 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention   -  
Onepat1 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention   -
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

cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
0
Onepat1 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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


0
Onepat1 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Je ne connais pas du tout cette fonction shape !
il me pointe une erreur sur cette ligne:
Range("B" & i).Value = s.Hyperlink.SubAddress
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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

@+
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Onepat1 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
merci pour le lien !
la petite macro ne fonctionne pas.
je vais essayer quelques lignes avec les shapes...
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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
0
Onepat1 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
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.
0