Create email with contents in order: Text, Image, Text, Image, Text, Signature

I am working in Excel. I want to draft an email in a specific format.

I can't find anything where an email is in this format:

Words
Image
Words
Image
Words
Signature

I found ones that are words, image, image and signature which I used to build mine.

This is how it appears:

This is how it should look:

I left all I tried as commented out sections.

Sub EmailGenerate()
    
    Dim objOutApp As Object, objOutMail As Object
    Dim strBody As String, strSig As String, strEnd As String, strBody2 As String
    Dim rng As Range, rng2 As Range
    Dim r As Long, r2 As Long
    Dim wdDoc As Word.Document
    Dim Selection As Word.Selection
    Dim Selection2 As Word.Selection
     
    r = shEmail.Cells(Rows.Count, 15).End(xlUp).Row
    Set rng = shEmail.Range("K1:" & Cells(r, 21).Address)
    
    r2 = shEmail.Cells(Rows.Count, 23).End(xlUp).Row
    Set rng2 = shEmail.Range("W1:" & Cells(r2, 29).Address)
    
    Set objOutApp = CreateObject("Outlook.Application")
    Set objOutMail = objOutApp.CreateItem(0)
    Set wdDoc = objOutMail.GetInspector.WordEditor
     
    With objOutMail
        'If sent on behalf of another email address
        ' .SentOnBehalfOfName = ""
        'Setting the email conditions
        .To = shEmail.Cells(1, 2).Value
        .CC = shEmail.Cells(2, 2).Value
        .BCC = ""
        'Checks all email names
        .Recipients.ResolveAll
        .Subject = shEmail.Cells(4, 2).Value
        'This must be visible to get the default signature
        .Display
        'Get the html code from the signature
        strSig = .htmlbody
        'This is what the email body should say
      
       ' rng.Copy
       ' wdDoc.Application.Selection.Start = Len(strBody)
       ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
       ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
       ' wdDoc.Content.InsertParagraphAfter
       ' rng2.Copy
       ' wdDoc.Application.Selection.Start = Len(strBody) + Len(strBody2)
       ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
       ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
      
       ' rng1.Copy
       ' wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
      
        rng.Copy
        wdDoc.Content.InsertParagraphBefore
        wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
        wdDoc.Content.InsertParagraphAfter
      
        strBody = "<Body style=font-size:11pt;font-family:Calibri>" & _
          shEmail.Cells(5, 2).Value & "</p>" & _
          "<p>" & "</p>" & _
          "<p>" & shEmail.Cells(6, 2).Value & "</p>" & _
          "<p>" & shEmail.Cells(7, 2).Value & "</p>" & _
          "<p>" & "</p>" & _
          "<p>" & shEmail.Cells(8, 2).Value & "</p>"
          
        strBody2 = "<Body style=font-size:11pt;font-family:Calibri>" & _
          shEmail.Cells(10, 2).Value & "</p>" & _
          "<p>" & "</p>"
       
        rng2.Copy
        wdDoc.Content.InsertParagraphBefore
        wdDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
        wdDoc.Content.InsertParagraphAfter
        
        objOutMail.htmlbody = strBody2 & _
          .htmlbody
         
        ' rng2.Copy
        ' wdDoc.Application.Selection.Start = Len(strBody) + Len(strBody2)
        ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
        ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
    
        'Combines the email with image and the signature
        objOutMail.htmlbody = strBody & _
          .htmlbody
      
        'Automatically sends the email, should pop up briefly.
        '.Send
    
    End With
    
    On Error GoTo 0
    Set objOutMail = Nothing
    Set objOutApp = Nothing
     
End Sub

rng is the larger table and rng2 is the smaller table.

.Cells(5,2) through to (8,2) go before rng and (10,2) goes after rng and before rng2 then (12,2) would go after rng2 and before the signature.

Solution

Please, try the next approach. It is difficult to mix WordEditor with html, at least, I did not do it an I do not know how/if it can be done. Everything (I understood) you need can be done using WordEditor object or html using PropertyAccessor and link to picture paths. I am using in your adapted code only WordEditor:

Sub EmailGenerate()
 Dim objOutApp As Object, objOutMail As Object
 Dim rng As Range, rng2 As Range, shEmail As Worksheet
 Dim r As Long, r2 As Long
 Dim wdDoc As Word.document, wdRange As Word.Range
 
 Set shEmail = ActiveSheet 'use here your necessary sheet
 
 r = shEmail.cells(Rows.count, 15).End(xlUp).row
 Set rng = shEmail.Range("K1:" & cells(r, 21).Address)

 r2 = shEmail.cells(Rows.count, 23).End(xlUp).row
 Set rng2 = shEmail.Range("W1:" & cells(r2, 29).Address)

 Set objOutApp = CreateObject("Outlook.Application")
 Set objOutMail = objOutApp.CreateItem(0)
 Set wdDoc = objOutMail.GetInspector.WordEditor
  
 With objOutMail
    'If sent on behalf of another email address
    '.SentOnBehalfOfName = ""
    'Setting the email conditions
    .To = shEmail.cells(1, 2).Value
    .cc = shEmail.cells(2, 2).Value
    .BCC = ""
    'Checks all email names
    .Recipients.ResolveAll
    .subject = shEmail.cells(4, 2).Value
    'This must be visible to get the default signature
    .display 'Please, look here if its appearance is what you need.
    
    'Declare the string variables to be used:
    Dim strFrst As String, strSec As String, strThird As String, strF As String
    
    'Give values to the strings (they can take the values from the sheet...)
    strFrst = "Hello All!" & vbCrLf & vbCrLf
    strSec = "Please, receive the picture you requested:" & vbCrLf & vbCrLf
    strThird = "And the second picture is following:" & vbCrLf & vbCrLf
    strF = "The last necessary string is here..." & vbCrLf
    
    'Write the first two text lines:________________
    wdDoc.Paragraphs(1).Range.InsertAfter (strFrst)
    wdDoc.Paragraphs(2).Range.InsertAfter (vbCrLf) 'insert an empty line
    wdDoc.Paragraphs(3).Range.InsertAfter (strSec)
    '_______________________________________________
    
    'Embed the first picture__________________________________________
    rng.Copy
    wdDoc.Paragraphs(5).Range.PasteSpecial , , , , wdPasteBitmap
    '_________________________________________________________________
    
    wdDoc.Paragraphs(5).Range.InsertAfter (vbCrLf) 'empty line after first picture
    
    'insert the third string:_______________________
    wdDoc.Paragraphs(6).Range.InsertAfter (strThird)
    '_______________________________________________
      
    'Embed the second picture___________________________________
    rng2.Copy
    wdDoc.Paragraphs(8).Range.PasteSpecial , , , , wdPasteBitmap
    '___________________________________________________________
    
    'insert the fourth string:__________________
    wdDoc.Paragraphs(8).Range.InsertAfter (strF)
    '___________________________________________
    
    
    'Automatically sends the email, should pop up briefly.
    '.Send
 End With
End Sub

Please, test it and send some feedback.