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
  • 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

943 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now