Lier une image à une ligne d'une feuille excel

Résolu
Jalalrid -  
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.

8 réponses

  2.  cs_Le Pivert Contributeur
    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à

    0
    1. Jalalrid Auteur
      Merci pour ce code.
      Il fonctionne que quand je clique sur la flèche exécuter sub/userform de la fenêtre de vba. Le double clic ne fonctionne pas. Serait il possible de remplacer le double clic par un raccourci clavier comme ctrl+d
      0
  3. cs_Le Pivert Contributeur
    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
    0
    1. cs_Le Pivert Contributeur
      [http://static.commentcamarche.net/www.commentcamarche.net/pictures/QzhrOtPJLUR1p1GprZBfpsJdOJimK0nn3ZLtXCIuk5je1JjCbeJuWMTHIRW0aZJL-capture.png [image:http://st
      atic.commentcamarche.net/www.commentcamarche.net/pictures/QzhrOtPJLUR1p1GprZBfpsJdOJimK0nn3ZLtXCIuk5je1JjCbeJuWMTHIRW0aZJL-capture-s-.png|1024px||center]|fancy]
      0
      1. Jalalrid Auteur
        Merci. Ce code est super. y a t il la possibilité de remplacer le double clic par un raccourci clavier (ctrl+d) (car j'utilise le double clic pour rentrer les données dans une cellule lors de la saisie) et faire en sorte que même si je ne choisis pas de fichier le code ne se plante pas (ça marque "erreur d'exécution 483" quand je ne choisis pas de fichier)
        Merci pour ce coup de main.
        0
    3. cs_Le Pivert Contributeur
      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


      0
      1. cs_Le Pivert Contributeur
        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
        0
        1. cs_Le Pivert Contributeur
          J'ai oublié une chose la position de la cellule cliquée:
          mettre ceci: 

          Private Sub Worksheet_SelectionChange(ByVal Target As Range)
position = Target.Address
End Sub


          et changer ceci: 

          Private Sub Insererimage()
On Error Resume Next
ImportImage
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "", SubAddress:="Feuil2!" & position
 End Sub
          0
        2. cs_Le Pivert Contributeur
          J'ai testé la manip pour le raccourci, il faut mettre: 

          Sub Insererimage()
On Error Resume Next
ImportImage
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "", SubAddress:="Feuil2!" & position
 End Sub


          pour pouvoir voir la macro
          0
        3. Jalalrid Auteur
          @cs_Le PivertMerci pour toutes ces macros mais je m'y perds actuellement.
          Serait il possible d'avoir une seule avec toutes les dernières modifications.
          Merci pour votre compréhension.
          0
      2. cs_Le Pivert Contributeur
        Voila un exemple avec raccourci clavier:

        http://www.cjoint.com/c/EGciH7DkMkQ
        0
        1. Jalalrid Auteur
          Ce classeur est super génial.
          Bon travail. Merci. Si possible j'aimerais aussi à programmer comme ça (c'est quoi les ressources dispo pour arriver à ce niveau en vba??))
          Encore merci.
          0
        3. Jalalrid
          @cs_Le PivertMerci.
          J'ai copié le code dans une nouvelle feuille de calcul. Mais le raccourci ne fonctionne pas sur cette nouvelle feuille. Pourrais je savoir comment je m'y prends pour insérer ce raccourci sur ma nouvelle feuille de calcul?
          0
      3. cs_Le Pivert Contributeur
        Je t'ai donné le lien précédemment

        http://www.info-3000.com/vbvba/raccourciclavier.php
        0
        1. Jalalrid Auteur
          J'ai saisi le code suivant pour réaliser un formulaire et le problème que j'ai c'est qu'il n'affiche pas les valeurs correctes dans les colonnes que je voudrais. Voici le lien vers cette feuille de calcul: http://www.cjoint.com/c/EGiiXVIcnlT
          Pourriez vous m'aider avec ce code pour finaliser mon fichier? Serait il possible aussi d'ajouter la colonne B qui doit comporter les images à ce formulaire afin que le choix de l'image à insérer se fasse directement à partir de ce formulaire?
          Merci d'avance.
          0

      Discussions similaires

      Retrouver l'image originale d'une photo modifiée
      Raven

      10 réponses