Batch insert pictures using VBA (embedding the pictures not linking them)

Posted on 2013-11-18
Last Modified: 2013-11-26
Dear Experts:

below macro, created by Rgonzo and Rorya batch inserts pictures in Column D. The network paths are located in Column C.

The macro works just fine. I am really happy with it. But there is one thing I would like to get adjusted. The graphics are not embedded but are linked to the correspoding file.

How has the macro to be adjusted so that the graphics get embedded?

I came across this code snippet in this respect but I guess is of no use in this case ...

 ' ActiveSheet.Shapes.AddPicture Filename:="C:\test\desert.jpg", linktofile:=msoFalse, _
   '         savewithdocument:=msoCTrue, Left:=0, Top:=0, Width:=100, Height:=100

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub InsertPictures_linked_to_file()
' by Rgonzo and rorya

   Dim c                           As Range
   Dim Image                       As Picture
  On Error Resume Next
   For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
      c.Offset(0, 1).Activate
            Set Image = ActiveSheet.Pictures.Insert(c.Value2)
      With Image
         If .Height > Application.CentimetersToPoints(4) Then _
                  .ShapeRange.ScaleHeight Application.CentimetersToPoints(4) / .Height, msoCTrue
                  .TopLeftCell.RowHeight = Image.Height + 10

         If .Height > .Width Then
            With .ShapeRange
               .Rotation = 90
               .IncrementLeft .Height / 2 - .Width / 2
               .IncrementTop .Width / 2 - .Height / 2 + 5
            End With
        .TopLeftCell.RowHeight = Image.Width + 10
        Else: .ShapeRange.IncrementTop (5)
         End If
      End With
End Sub
Question by:AndreasHermle
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
LVL 85

Accepted Solution

Rory Archibald earned 500 total points
ID: 39673931
Hi Andreas,

Try this:
Sub InsertPictures_embedded_in_file()
' by Rgonzo and rorya

   Dim c                           As Range
   Dim Image                       As Shape

   For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
      If Len(c.Value) > 0 Then
         If Dir(c.Value) <> "" Then
            With c.Offset(0, 1)
               Set Image = ActiveSheet.Shapes.AddPicture(Filename:=c.Value2, linktofile:=msoFalse, _
                                                         savewithdocument:=msoCTrue, Left:=.Left, _
                                                         Top:=.Top, Width:=-1, Height:=-1)

            End With

            With Image
               If .Height > Application.CentimetersToPoints(4) Then _
                  .ScaleHeight Application.CentimetersToPoints(4) / .Height, msoCTrue
               .TopLeftCell.RowHeight = Image.Height + 10

               If .Height > .Width Then
                  .Rotation = 90
                  .IncrementLeft .Height / 2 - .Width / 2
                  .IncrementTop .Width / 2 - .Height / 2 + 5
                  .TopLeftCell.RowHeight = Image.Width + 10
                  .IncrementTop 5
               End If
            End With
         End If
      End If
End Sub

Open in new window


Author Comment

ID: 39675828
Hi rory,

thank you very much  for your help.

I will be at my working place tomorrow and do some testing ...

Till then,

Regards, Andreas

Author Closing Comment

ID: 39677648
Hi Rory,

just did some testing.

GREAT! this did the trick, every graphic nicely embedded! And very fast! I am really happy with this code :)

Thank you very much for your superb and professional help.

Regards, Andreas

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question