Solved

Excel macro to import pictures from file

Posted on 2014-01-04
4
915 Views
Last Modified: 2014-01-05
I have a list of picture names in Column A.  I want to import from a folder the images that match the names in Column A and place them in Column B beside the name.


A                                   B
Image Name            Actual Image

There are about 400 of the images. Looking for VBA code to do the import from folder.
0
Comment
Question by:laskydiver
  • 2
  • 2
4 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39757110
Give this a spin:

Option Explicit

Sub Demo()

    Dim rng As Range, cell As Range
    Dim strPicturesPath As String

    ' Set path of Pictures
    strPicturesPath = "C:\Test\"
    ' Set range containing picture names
    Set rng = Range("A1:A100")

    If Right(strPicturesPath, 1) <> "\" Then
        strPicturesPath = strPicturesPath & "\"
    End If

    On Error Resume Next
    For Each cell In rrng
        InsertPicture strPicturesPath & cell.Value, cell, True, True
    Next

End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        If CenterH Then
            w = .offset(0, 1).Left - .Left
            l = l + w / 2 - p.Width / 2
            If l < 1 Then l = 1
        End If
        If CenterV Then
            h = .offset(1, 0).Top - .Top
            t = t + h / 2 - p.Height / 2
            If t < 1 Then t = 1
        End If
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
    Set p = Nothing
End Sub

Open in new window

0
 

Author Comment

by:laskydiver
ID: 39757924
MacroShadow
It worked but the images came in full size. is there a way to re-size to something manageable.
0
 
LVL 27

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 39757983
Try this:

Option Explicit

Sub Demo()

    Dim rng As Range, cell As Range
    Dim strPicturesPath As String

    ' Set path of Pictures
    strPicturesPath = "C:\Test\"
    ' Set range containing picture names
    Set rng = Range("A1:A100")

    If Right(strPicturesPath, 1) <> "\" Then
        strPicturesPath = strPicturesPath & "\"
    End If

    On Error Resume Next
    For Each cell In rrng
        InsertPictureInRange strPicturesPath & cell.Value, cell
    Next

End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCells
        t = .Top
        l = .Left
    End With
    ' position picture
    With p
        .ShapeRange.LockAspectRatio = msoTrue
        .ShapeRange.Width = 100 ' Adjust to your liking
        .Top = t
        .Left = l
    End With
    Set p = Nothing
End Sub

Open in new window

0
 

Author Closing Comment

by:laskydiver
ID: 39758348
Thanks
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

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

Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
Outlook Free & Paid Tools
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …

810 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