Solved

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

Posted on 2013-11-18
3
401 Views
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
   Next
End Sub
0
Comment
Question by:AndreasHermle
[X]
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
3 Comments
 
LVL 85

Accepted Solution

by:
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
               Else
                  .IncrementTop 5
               End If
            End With
         End If
      End If
   Next
End Sub

Open in new window

0
 

Author Comment

by:AndreasHermle
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
0
 

Author Closing Comment

by:AndreasHermle
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
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
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.

688 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