Improve company productivity with a Business Account.Sign Up

x
?
Solved

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

Posted on 2013-11-18
3
Medium Priority
?
427 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:Andreas Hermle
  • 2
3 Comments
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 2000 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:Andreas Hermle
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:Andreas Hermle
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

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
With the functions here, you can parse, convert, and format back and forth between feet and inches and fractions and decimal inches - for normal as well as extreme values and with extreme precision.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

595 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