Insert pictures using VBA in Microsoft Excel





With the macro below you can insert pictures at any range in a worksheet.
The picture can be centered horizontally and/or vertically.

Sub TestInsertPicture()
    InsertPicture "C:\FolderName\PictureFileName.gif", _
        Range("D10"), True, True
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
    CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        If CenterH Then
            w = .Offset(0, 1).Left - .Left
            l = l + w / 2 - p.Width / 2
            If l < 1 Then l = 1
        End If
        If CenterV Then
            h = .Offset(1, 0).Top - .Top
            t = t + h / 2 - p.Height / 2
            If t < 1 Then t = 1
        End If
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
    Set p = Nothing
End Sub

With the macro below you can insert pictures and fit them to any range in a worksheet.

Sub TestInsertPictureInRange()
    InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
        Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing
End Sub


6 thoughts on “Insert pictures using VBA in Microsoft Excel

  1. “This just saved me a ton of time, thank you so much for posting!! If you ever edit this, it might be nice to enable the macro to either run on a certain range or an entire worksheet.
    Thanks again, David”

  2. I agree. It would be complete to enable the macro to run on a selected range. The changes could include replacing the “-” sign between the contents of the cells with a space. (This is can be done by almost anyone).

  3. Hello,

    I came across this post and think it could help me so I’m hoping you can help with just a little modification to the script.

    Is it easy to do the following? Insert product images in to Cell A1 based on the SKU that is inputted in to B2. These images are stored in F:\Images\ I will have about 500 SKU’s that all need images and will be named the same as the SKU I enter in to Column B.

    Hope somebody can help me.

    Matt

    • Matthew, I had a similar task to complete, I did it by using a loop and array.

      Sub TestInsertPictures()
      ‘ Used to import picture files from a pre-sorted file. (Each picture must have a unique name, duplicates removed).

      Dim PictureName(1 to 500) As String ‘Starting at row 1 and ending at row 500
      Dim FullPathName As String
      Dim Location(1 to 500) As String

      Dim r As Integer ‘loop count’

      For r = 1 To 500
      PictureName(r) = Cells(r,2) ‘Column B
      FullPathName = “C:\Folder\” & PictureName(r) & “.jpg”
      Location(r) = Cells(r,2).Address

      InsertPicture FullPathName, Range(Location(r)), False, False

      Next r
      End Sub

  4. Matthew, I had a similar task to complete, I did it by using a loop and array.

    Sub TestInsertPictures()
    ‘ Used to import picture files from a pre-sorted file. (Each picture must have a unique name, duplicates removed).

    Dim PictureName(1 to 500) As String ‘Starting at row 1 and ending at row 500
    Dim FullPathName As String
    Dim Location(1 to 500) As String

    Dim r As Integer ‘loop count’

    For r = 1 To 500
    PictureName(r) = Cells(r,2) ‘Column B
    FullPathName = “C:\Folder\” & PictureName(r) & “.jpg”
    Location(r) = Cells(r,2).Address

    InsertPicture FullPathName, Range(Location(r)), False, False

    Next r
    End Sub

  5. I have tried both the method outlined here as well as another method found on the web (inserting a rectangle shape and filling it with a user image).

    All methods seem to have some sort of compression going on.

    I am trying to automate an e-signature for medical forms going out signed off on by the Dr.

    Any tips?

    Nothing seems to replicate how crisp the signature looks if I do it non-programmatically (insert->image->choose file)

Leave a Reply

Your email address will not be published. Required fields are marked *


eight × 9 =

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>