Multiple Groups & Align Under

I have 30+ jpgs in a folder, each jpg is a picture of a person. The file name of the jpg is the name of the person in the picture.

I am trying to create a VBA macro that will import each image, create an artisitc text object below & centered under the picture using the filename as the text. I would like to group each set of imported picture and text. At the end I would have 30+ groups of pictures with the name of the person under the picture.

I have most of it below, but I can't seem to figure out how to group each image & text shape together. In the code below it groups all the images and all the text together.

I am also having trouble aligning the text centered and below the image.

Any help would be greatly appreciated.

Kuty

Sub Macro1()

Dim sr As New ShapeRange


MyPath = "C:\jpg\"

FileName = Dir(MyPath)
Bottom = 0
mLeft = 0
FileNumber = 0
GroupNum = 0

Do While FileName <> "" ' Start the loop.

FileNumber = FileNumber + 2
FileName1 = MyPath & FileName
'Import
ActiveLayer.Import FileName1
ActiveShape.Name = FileName

'Create Name
Bottom = Bottom + 1
mLeft = mLeft + 1
ActiveLayer.CreateArtisticText mLeft, Bottom, FileName, Font:="Arial"
ActiveShape.Name = "Text" & FileName

' Align Name and Shape
ActiveLayer.Shapes(FileName).AlignToShape cdrAlignBottom, ActiveLayer.Shapes("Text" & FileName)

'Group Name and Shape
GroupNum = GroupNum + 1
sr.Add ActiveLayer.Shapes(FileName)
sr.Add ActiveLayer.Shapes("Text" & FileName)
Set GroupNum = sr.Group

FileName = Dir() ' Get next entry.
Loop