Insérer en nombre des liens hypertexte dans des images

Bonjour à tous,

Je souhaiterais insérer automatiquement un lien hypertexte à une image et ce, sur de nombreuses lignes.

En colonne A, j'ai mes liens hypertexte (que j'ai réussi à créer avec une macro VBA).

En colonne B, je voudrais insérer une image par ligne (en B2, B3, B4...) (toujours la même image :

Puis que VBA m'insère le lien hypertexte de la cellule A2 dans l'image de la cellule B2 puis le lien de A3 dans l'image en B3 et ainsi de suite...

En cherchant sur le forum, j'ai essayé de différentes manières mais rien ne fonctionne vraiment correctement... J'arrive à insérer les images sur chaque ligne avec une boucle mais c'est très long. Et pour insérer le lien hypertexte je n'y arrive pas du tout :-( !

j'ajoute en PJ un fichier d'exemple avec 10 lignes (sachant que j'en ai 300)

Merci à vous pour votre aide !!

Bonjour,

J'aurais bien aimé me passer des select, mais je n'y suis pas arrivé pour insérer les liens hypertextes. Cela devrait faire l'affaire, avant d'être amélioré par d'autres personnes éventuellement sous peu !

Sub liens()
Dim Sh As Object
Application.ScreenUpdating = False

For Each Sh In Sheets(1).Shapes 'boucle sur toutes les formes de ta feuille
    If Sh.Name <> "Picture 1" Then Sh.Delete 'les supprime toutes sauf ta forme qui sert de modèle
Next

For x = 2 To ActiveSheet.UsedRange.Rows.Count 'on créé une boucle qui ira jusqu'à la dernière ligne occupée
Set Sh = Sheets(1).Shapes.Range(Array("Picture 1")).Duplicate 'on duplique ta forme modèle

With Sh
    .Select 'on la sélectionne. Je ne suis pas arrivé à me passer de cette instruction
    .Name = "Picture " & x ' on la renomme suivant la ligne sur laquelle on se trouve
    .Top = Cells(x, 2).Top 'on la positionne en haut de la ligne actuelle
    .Left = Cells(x, 2).Left ' on la positionne à gauche de la colonne B
End With
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Cells(x, 1).Value ' on ajoute le lien hypertexte qui pointe vers la cellule qui est sur la même ligne, colonne A
Next 'on poursuit la boucle
Cells(1, 1).Activate 'on se met en A1 pour ne pas garder de forme sélectionnée
End Sub

En gardant à l'esprit qu'insérer 300 images ou plus dans un fichier Excel ne sera jamais une bonne idée.

Super! Ca marche! merci beaucoup!!!

Bonjour Frip25, salut JoyeuxNoel

Suite à ton MP, voici le code sans select et avec des noms de variables explicites (je sais suis chiant la dessus)

Sub Liens()
  Dim Shp As Shape, ShpRng As ShapeRange
  Dim Lig As Long

  Application.ScreenUpdating = False
  ' Supprimer tous les Shape existant à part Image1
  For Each Shp In Sheets(1).Shapes
    If Shp.Name <> "Picture 1" Then Shp.Delete
  Next
  ' Pour chaque ligne jusqu'à la dernière remplie
  For Lig = 2 To ActiveSheet.UsedRange.Rows.Count
    ' Définir la page de forme
    Set ShpRng = Sheets(1).Shapes.Range(Array("Picture 1")).Duplicate 'on duplique ta forme modèle
    ' Avec cette plage de forme
    With ShpRng
      .Name = "Picture " & Lig                     ' on la renomme suivant la ligne sur laquelle on se trouve
      .Top = Cells(Lig, 2).Top                     'on la positionne en haut de la ligne actuelle
      .Left = Cells(Lig, 2).Left                   ' on la positionne à gauche de la colonne B
    End With
    ' on ajoute le lien hypertexte qui pointe vers la cellule qui est sur la même ligne, colonne A
    ActiveSheet.Hyperlinks.Add Anchor:=ShpRng.Item(1), Address:=Cells(Lig, 1).Value
  ' on poursuit la boucle
  Next
End Sub

@+

Re Bruno,

Merci beaucoup !

C'était donc une histoire de Range... J'ai du mal à comprendre pourquoi exactement il a besoin de ça. M'enfin ... :)

Un mystère de résolu, c'est bien là l'essentiel.

Bonjour à tous et merci à Joyeux Noel et à Bruno pour vos retours et votre aide, vous me faites gagner un temps énorme !

C'est bien là l'essentiel. Mais une nouvelle fois, insérer autant d'images n'est pas forcément une bonne idée.

Surtout pour des liens hypertextes, qui marchent tout aussi bien quand ce n'est que du texte !