• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 432
  • Last Modified:

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

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
Andreas Hermle
Asked:
Andreas Hermle
  • 2
1 Solution
 
Rory ArchibaldCommented:
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
 
Andreas HermleTeam leaderAuthor Commented:
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
 
Andreas HermleTeam leaderAuthor Commented:
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
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

Featured Post

Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now