Hi,

I am using the code below to insert and resize images in excel. I was wondering is it possible to set up this macro so that I can just provide the directory and then have it so that just a random image is inserted rather than specifying an jpg number. The reason i need this is because the numbers in the folder range from 00000 to upto 20000 however not every folder has the full range of images i.e. Z:\Singapore\Singapore Turf\Singapore Turf Club 2\QEII Cup 2006\QEII Cup 2006_VD\Millenium Copthorne International\TVGI Race Name Text\ may just contain one image and that would be image number 03965.

The other thing I would like to do is to have the name of the las 2 subfolders inserted into the cell above the image so for the example below you would have:

Millenium Copthorne International\TVGI Race Name Text
Picture

Millenium Copthorne International\TVGI Race Name Logo
Picture

Is this possible?


Sub TestInsertPictureInRange() 
    InsertPictureInRange "Z:\Singapore\Singapore Turf\Singapore Turf Club 2\QEII Cup 2006\QEII Cup 2006_VD\Millenium Copthorne International\TVGI Race Name Text\03965.jpg", _ 
    Range("B5:D10") 
    InsertPictureInRange "Z:\Singapore\Singapore Turf\Singapore Turf Club 2\QEII Cup 2006\QEII Cup 2006_VD\Millenium Copthorne International\TVGI Race Name Logo\00015.jpg", _ 
    Range("E5:G10") 
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, 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 TargetCells 
        t = .Top 
        l = .Left 
        w = .Offset(0, .Columns.Count).Left - .Left 
        h = .Offset(.Rows.Count, 0).Top - .Top 
    End With 
     ' position picture
    With p 
        .Top = t 
        .Left = l 
        .Width = w 
        .Height = h 
    End With 
    Set p = Nothing 
End Sub