Lier une image à une ligne d'une feuille excel Résolu/Fermé

Question

Bonjour, 
j'aimerais insérer plusieurs photos sur une feuille excel par exemple la feuille 1 (ça je sais le faire).
Je voudrais lier chacune de ces photos à une ligne particulière dans la feuille 2 de telle sorte que si je clique sur la photo je vais à l'information correspondante dans la feuille 2 à la ligne concernée. Serait il possible de le faire?
Si oui comment? Aussi cela peut il être automatique c'est à dire que si à chaque fois que j'ajoute une photo, et que je clique sur celle ci elle me renvoie à ligne suivante. 
Merci d'avance pour votre aide.


Configuration: Windows 8 / Chrome 43.0.2357.130

cs_Le Pivert · Answer

Bonjour,

Voir ceci:

http://boisgontierjacques.free.fr/pages_site/lesimages.htm#InsertionImage

cs_Le Pivert · Answer

Faire Alt F11 pour accéder a l'éditeur, ensuite sélectionner la feuille qui recevra les images.
Mettre ce code:

Option Explicit
Dim Image, nomimage As String
Dim a, c
Sub ImportImage()
  Image = Application.GetOpenFilename("Fichiers Gif ou Jpg ,*.gif;*.jpg")
  If Image <> False Then
    a = Split(Image, "\")
    nomimage = a(UBound(a))
    Set c = ActiveCell
    With ActiveSheet
      .Pictures.Insert(Image).Name = nomimage
      .Shapes(nomimage).Height = c.Height
      .Shapes(nomimage).Width = c.Width
      .Shapes(nomimage).Left = c.Left
      .Shapes(nomimage).Top = c.Top
      .Shapes(nomimage).LockAspectRatio = msoTrue
    End With
  End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ImportImage
End Sub


A chaque double clic sur une cellule une boite de dialogue demandera de choisir une image pour l'insérer sur la cellule sélectionnée.

Ensuite il ne restera qu' a faire un clic droit sur l'image:
Lien Hypertexte
Emplacement dans ce document 

Voilà

cs_Le Pivert · Answer

Il ne faut pas mettre ce code dans une UserForm! 
Sélectionner la feuille concernée en haut à gauche dans l'éditeur
En haut s'affiche General, cliquez sur Worksheet
A droite sélectionner: BeforeDoubleClick et mettre ce code:

Option Explicit
Dim Image, nomimage As String
Dim a, c, position
Sub ImportImage()
  Image = Application.GetOpenFilename("Fichiers Gif ou Jpg ,*.gif;*.jpg")
  If Image <> False Then
    a = Split(Image, "\")
    nomimage = a(UBound(a))
    Set c = ActiveCell
    With ActiveSheet
      .Pictures.Insert(Image).Name = nomimage
      .Shapes(nomimage).Height = c.Height
      .Shapes(nomimage).Width = c.Width
      .Shapes(nomimage).Left = c.Left
      .Shapes(nomimage).Top = c.Top
      .Shapes(nomimage).LockAspectRatio = msoTrue
      .Shapes(nomimage).Select
   End With
   End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
position = Target.Address
ImportImage
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "", SubAddress:="Feuil2!" & position
End Sub


j'ai ajouter le lien hypertexte automatique

cs_Le Pivert · Answer

[http://static.commentcamarche.net/www.commentcamarche.net/pictures/QzhrOtPJLUR1p1GprZBfpsJdOJimK0nn3ZLtXCIuk5je1JjCbeJuWMTHIRW0aZJL-capture.png [image:http://static.commentcamarche.net/www.commentcamarche.net/pictures/QzhrOtPJLUR1p1GprZBfpsJdOJimK0nn3ZLtXCIuk5je1JjCbeJuWMTHIRW0aZJL-capture-s-.png|1024px||center]|fancy]

cs_Le Pivert · Answer

Je vois cela demain pour le raccourci.
Pour  l'erreur "erreur d'exécution 483" en attendant

Mets ceci:

Sub ImportImage()
On Error Resume Next 'ajouter cela
  Image = Application.GetOpenFilename("Fichiers Gif ou Jpg ,*.gif;*.jpg")
  If Image <> False Then
    a = Split(Image, "\")
    nomimage = a(UBound(a))
    Set c = ActiveCell
    With ActiveSheet
      .Pictures.Insert(Image).Name = nomimage
      .Shapes(nomimage).Height = c.Height
      .Shapes(nomimage).Width = c.Width
      .Shapes(nomimage).Left = c.Left
      .Shapes(nomimage).Top = c.Top
      .Shapes(nomimage).LockAspectRatio = msoTrue
      .Shapes(nomimage).Select
   End With
   End If
End Sub

cs_Le Pivert · Answer

Pour le raccourci clavier changer:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
position = Target.Address
ImportImage
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "", SubAddress:="Feuil2!" & position
End Sub

en 

Private Sub Insererimage()
On Error Resume Next  
position = Target.Address
ImportImage
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "", SubAddress:="Feuil2!" & position
End Sub

Ensuite le raccourci clavier, il va falloir te le faire en consultant ce site.
Tu le mets pour la macro: Insererimage

http://www.info-3000.com/vbvba/raccourciclavier.php

cs_Le Pivert · Answer

Voila un exemple avec raccourci clavier:


 http://www.cjoint.com/c/EGciH7DkMkQ

cs_Le Pivert · Answer

Je t'ai donné le lien précédemment

 http://www.info-3000.com/vbvba/raccourciclavier.php