Inserting photos into Excel using VBA

Question

I have a VBA code that pulls photos into excel based on the cells in column D.

Sub Insert2()
Const fPath = "C:\path"
Dim a As Variant, cel As Range, picPath As String


For Each a In Array("F4", "F5", "F6")
    Set cel = Sheets("Medium").Range(a)

    picPath = fPath & "\" & cel.Value & ".jpg"
    
    If Not Dir(picPath, vbDirectory) = vbNullString Then
        With cel.Parent.Pictures.Insert(picPath)
            With .ShapeRange
                .LockAspectRatio = msoFalse
                .Width = 70
                .Height = 70
            End With
            
            .Left = cel.Offset(, 1).Left
            .Top = cel.Offset(, 1).Top
            
        End With
    End If
Next a
End Sub

How can I put a range into the array? I would like to be able to pull F4:F12.

Thanks

Does this answer your question? [Creating an Array from a Range in VBA](https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba) — Warcupine, Oct 19 '20 at 15:32
Sounds like an XY problem. `For Each a In Array("F4", "F5", "F6")`, `Set cel = Sheets("Medium").Range(a)` can just be `For Each cel in Sheets("Medium").Range("F4:F12")`. — BigBen, Oct 19 '20 at 15:47

score 0 · Answer 1 · answered Oct 19 '20 at 16:05

There are two ways to use the range itself and a way to put the range into an array.

use the range itself

Sub Insert3()
    Const fPath = "C:\path"
    Dim cel As Range, picPath As String
    Dim rngDB As Range
    Dim Ws As Worksheet
    
    Set Ws = Sheets("Medium")
    Set rngDB = Ws.Range("f4", "f12")
    
    For Each cel In rngDB
        picPath = fPath & "\" & cel.Value & ".jpg"
        
        If Not Dir(picPath, vbDirectory) = vbNullString Then
            With cel.Parent.Pictures.Insert(picPath)
                With .ShapeRange
                    .LockAspectRatio = msoFalse
                    .Width = 70
                    .Height = 70
                End With
                
                .Left = cel.Offset(, 1).Left
                .Top = cel.Offset(, 1).Top
                
            End With
        End If
    Next cel
End Sub

put the range into an array.

Sub Insert4()
    Const fPath = "C:\path"
    Dim cel As Range, picPath As String
    Dim rngDB As Range
    Dim rngA() As Range
    Dim Ws As Worksheet
    Dim n As Integer
    Dim c As Variant
    
    Set Ws = Sheets("Medium")
    Set rngDB = Ws.Range("f4", "f12")
    
    For Each cel In rngDB
        n = n + 1
        ReDim Preserve rngA(1 To n)
        Set rngA(n) = cel
    Next cel
    
    For Each c In rngA
        picPath = fPath & "\" & cel.Value & ".jpg"
        
        If Not Dir(picPath, vbDirectory) = vbNullString Then
            With c.Parent.Pictures.Insert(picPath)
                With .ShapeRange
                    .LockAspectRatio = msoFalse
                    .Width = 70
                    .Height = 70
                End With
                
                .Left = cel.Offset(, 1).Left
                .Top = cel.Offset(, 1).Top
                
            End With
        End If
    Next c
End Sub

Inserting photos into Excel using VBA

1 Answers1