Insert Picture then Next

[Boots6]

I have this code to insert my pictures half size into a certain cell. How can I get it to give the option to choose another picture and insert it the next available cell? Here's my code:

Sub EmbedPicture()

Dim sPicture As String, pic As Picture

ChDir "C:\Pathname\"
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
ActivateCell:
.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft

.Top = Range("B36").Top
.Left = Range("B36").Left

End With

Set pic = Nothing

End Sub

Thanks!

 

[SkipVought]

hi,

Try something like this...

Sub EmbedPicture()
  
    Dim sPicture As String, pic As Picture
    Dim oFSO As Object, oFile As Object
    Dim lRow As Long, oCell As Range
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    lRow = 2
    With ActiveSheet
        For Each oFile In oFSO.getfolder("C:\Pathname\").Files
            Select Case Right(oFile.Name, 3)
                Case "gif", "jpg", "bmp", "tif"
                    Set oCell = .Cells(lRow, "A")
                    With .Pictures.Insert(oFile.Path)
                        
                        .ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
                
                        .Top = oCell.Top
                        .Left = oCell.Left
                    End With
                    lRow = lRow + 1
            End Select
        Next
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}