excelvbaexcel-2013

How to add picture to Excel instead link to file


I have small VBA form to insert picture to a cell but if the file image was deletd or renamed the image on Excel file was missing too, this is my sample code

Private Sub CommandButton1_Click()
  Sheet3.Activate
  Dim uk_gbr As Range
  Dim gbr As Object
  Dim tp_gbr As String
  Dim I As Integer
    
  tp_gbr = Application.GetOpenFilename("Pilih Gambar (*.jfif; *.jpg; *.png)," & _
    "*.jfif; *.jpg; *.png", MultiSelect = True)
    
  If tp_gbr <> CStr(False) Then
    On Error Resume Next
    Set uk_gbr = Application.InputBox("Pilih Cell:", "Masukkan Gambar", ActiveCell.Address, Type:=8)
    On Error GoTo 0
      uk_gbr.Activate
      Set gbr = ActiveSheet.Pictures.Insert(tp_gbr)
      gbr.ShapeRange.Height = 249.12
  End If
  
  Set uk_gbr = Nothing
  Set gbr = Nothing
Sheet1.Activate
End Sub

I'm new on vba so this code was search through internet.


Solution

  • This will do the trick

    Set gbr = ActiveSheet.Shapes.AddPicture(Filename:=tp_gbr, _
                                            linktofile:=msoFalse, _
                                            savewithDocument:=msoTrue, _
                                            Left:=0, _
                                            Top:=0, _
                                            Width:=-1, _
                                            Height:=-1) ' -1 retains the width/height of the original picture
    gbr.Height = 249.12 'gbr.ShapeRange.Height = 249.12 'doesn't work here 
    

    Also you could use Left:=ActiveCell.Left, Top:=ActiveCell.Top in place of Left:=0, Top:=0

    The following code inserts the picture on the location of the uk_gbr cell and fits the image size to the range dimension.

    Just replace

    Set gbr = ActiveSheet.Pictures.Insert(tp_gbr)
    gbr.ShapeRange.Height = 249.12
    

    with

    Set gbr = ActiveSheet.Shapes.AddPicture(Filename:=tp_gbr, _
                                            linktofile:=msoFalse, _
                                            savewithDocument:=msoTrue, _
                                            Left:=uk_gbr.left, _
                                            Top:=uk_gbr.top, _
                                            Width:=uk_gbr.width, _
                                            Height:=uk_gbr.height)