Add Image Button

[OKCIrish]

Hello,

I have this VBA code, attached below, to react to a form control of a button. Anytime the user clicks the button it will pull up their photos and they can select the photo they want to use and it will paste it in a certain cell/section. After the report is done, everything gets converted to PDF and the pictures are there on the PDF report. However, my issue is that if I need to fix something on their report or they have to send the excel report to me, the link for the pictures becomes broken and the pictures won't send with the file or display correctly on the excel file I receive. Can I get some help on this coding to make it where the picture is attached to the file instead of it being pasted? I have attached an image since is a form control and won't show anything if I do XL2BB.

Sub AddImages1()
Dim strFileName As String
Dim objPic As Picture
Dim rngDest As Range

strFileName = Application.GetOpenFilename( _
    FileFilter:="Images,*.jpg;*.gif;*.png", _
    Title:="Please select an image...")

If strFileName = "False" Then Exit Sub

Set rngDest = Worksheets("Images").Range("B12:F12")
Set objPic = Worksheets("Images").Pictures.Insert(strFileName)

With objPic

  .Height = rngDest.Height
  .Width = rngDest.Width
  .Left = rngDest.Left
  .Top = rngDest.Top

End With

Set rngDest = Nothing
Set objPic = Nothing

End Sub

 

[Domenic]

Try using the AddPicture method instead, like this...

Sub AddImages1()

    Dim strFileName As String
    Dim objPic As Shape
    Dim rngDest As Range
    
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images,*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    
    If strFileName = "False" Then Exit Sub
    
    Set rngDest = Worksheets("Images").Range("B12:F12")
    
    With rngDest
        Set objPic = Worksheets("Images").Shapes.AddPicture(Filename:=strFileName, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    End With
    
    Set rngDest = Nothing
    Set objPic = Nothing

End Sub

Notice that objPic is now declared as Shape.

Does this help?

 

[OKCIrish]

Try using the AddPicture method instead, like this...

Sub AddImages1()

    Dim strFileName As String
    Dim objPic As Shape
    Dim rngDest As Range
   
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images,*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
   
    If strFileName = "False" Then Exit Sub
   
    Set rngDest = Worksheets("Images").Range("B12:F12")
   
    With rngDest
        Set objPic = Worksheets("Images").Shapes.AddPicture(Filename:=strFileName, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    End With
   
    Set rngDest = Nothing
    Set objPic = Nothing

End Sub

Notice that objPic is now declared as Shape.

Does this help?

It does help and make the picture stay when sending as an excel file, however the picture doesn't auto fit to its area like the old code used to. Any help with that? I have attached comparison of your code provided to the old one.

 

[OKCIrish]

Never mind, I figured it out!

 

[Domenic]

That's great, glad you have it all sorted it.

Cheers!