I am trying to create a word document report that includes photos with an associated description using Excel VBA. The photo names are in column A and the descriptions are in columns B:I of the excel spreadsheet. The current macro opens the FileDialogFolderPicker and the user pick the folder that contains the pictures they want. The macro picks the associated picture based off the photo name in coulmn A then creates the word document and inserts the photos and descriptions. I am having trouble with inserting the correct photos and descriptions into the word document in the correct locations. I would also like to lock the aspect ratio of each photo and be able to specify the size of the photo in inches. I have included photos of what is currently happening with the word document and also what I would like the final result to look like. Any help would be greatly appreciated.

Sub Module2()

Dim ws As Worksheet, lastR As Long, rngPict As Range, rngP As Range, cel As Range
Dim myDialog As FileDialog, myFolder As String, myFile As String, myPicture As String
Dim x As Single, y As Single, W As Single, h As Single
Const picturesColumn As String = "A" 'the column keeping the pictures name list

Set ws = ActiveSheet 
lastR = ws.Cells(ws.Rows.Count, picturesColumn).End(xlUp).Row 'last row for photo names
Set rngPict = ws.Range(ws.Cells(2, picturesColumn), ws.Cells(lastR, picturesColumn)) 'the photo names range

Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)

With myDialog
   .Title = "Select the folder with structure photos"
   .AllowMultiSelect = False
   If .Show <> -1 Then Exit Sub 'nothing has been selected...
   myFolder = .SelectedItems(1) & Application.PathSeparator
End With

Dim wdApp As Word.Application
Set wdApp = New Word.Application

With wdApp
    .Visible = True
    .Activate
    
    .Documents.Add

End With

'Iterate between each cell of pictures range and insert if picture exists in myFolder:
For Each cel In rngPict.Cells
    myFile = Dir(myFolder & cel.Value & "?") 'with extension in cel.value...
    If myFile <> "" Then

        myPicture = myFolder & myFile
    
    With wdApp.Selection
    
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Size = 12
        
        Dim wrdPic As Word.InlineShape
        Set wrdPic = .Range.InlineShapes.AddPicture(Filename:=myPicture, LinkToFile:=False, SaveWithDocument:=True)
        
        .TypeText (ThisWorkbook.Sheets("Sheet1").Cells(2, 10).Text)
        .TypeText (ThisWorkbook.Sheets("Sheet1").Cells(2, 11).Text)
        .TypeText (ThisWorkbook.Sheets("Sheet1").Cells(2, 12).Text)
        .TypeText (ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Text)
        .TypeText ". "
        .TypeText (ThisWorkbook.Sheets("Sheet1").Cells(3, 2).Text)
        .TypeParagraph
        .TypeParagraph
        
    End With
        
    End If
    
Next cel

End Sub

Here are photos of my current spreadsheet, current word document produced and expected word document to be produced: