Quantcast
Channel: Excel IT Pro Discussions forum
Viewing all articles
Browse latest Browse all 11829

Insert a picture and link it to the worksheet VBA

$
0
0

Hi everyone,

I have a code that enables me to add pictures whose names match the names written in the column B of my file.

The problem I have is that the code doesn't embedd the pictures in the excel file, if I move them from the hard drive, or if I mail the excel file, then the pictures are gone.

I know that the problem is that I use the Insert.Pictures command while I should use the Shapes.AddPicture but I really don't know how to correctly incorporate it in my code.

Here it is :

Sub Affiche_Image()
Dim Ws As Worksheet                   ' Sert à manipuler plus facilement l'objet feuille
Dim Image As String                   ' Contiendra le nom de l'image
Dim Lg As Long                        ' Numéro de la dernière ligne colonne B

  Set Ws = Sheets("Feuil1")                                           ' Nom de la feuille

  Application.ScreenUpdating = False                                  ' Interdit le raffraîchissement d'écran
  
  Efface_Images
  
  With Ws
  
    For Lg = 1 To .Range("B65536").End(xlUp).Row                      ' Parcourt de toute la colonne B
    
      Image = ThisWorkbook.Path & "\CJ\" & .Cells(Lg, "B")        ' Répertoire à actualiser
        
      On Error Resume Next                                            ' On s'affranchit des erreurs
      With .Pictures.Insert(Image).ShapeRange                       ' On insère l'image dont le nom est en colonne B
        .LockAspectRatio = msoFalse                                   ' On peut la redimmensionner comme on veut
        .Left = Ws.Cells(Lg, "A").Left                                ' Position gauche
        .Top = Ws.Cells(Lg, "A").Top                                  ' Position Haut
        .Width = Ws.Cells(Lg, "A").Width                              ' Largeur
        .Height = Ws.Cells(Lg, "A").Height                            ' hauteur
      End With
      If Err.Number > 0 Then                                          ' Si une erreur (image non présente)
        MsgBox .Cells(Lg, "B") & vbCr & "Image inexistante"           ' On le signale
      End If
    Next Lg
  End With
End Sub

If anybody can help me !

Thank you all.

Laure


Viewing all articles
Browse latest Browse all 11829

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>