My code doesnt work. Help!! Attach is the example that should be the outcome and current outcome and the link for excel workbook

Public Sub Insert_Charts_In_New_Email()
    
    Dim outApp As Object 'Outlook.Application
    Dim outMail As Object 'Outlook.MailItem
    Dim wEditor As Object 'Word.Document
    Dim wRange As Object 'Word.Range
    Dim chartsSheet As Object
    Dim chartObj As ChartObject
    Dim chartWidthCm As Single, chartHeightCm As Single
    Dim rng As Range
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Range
    Dim rng5 As Range
    'Required chart dimensions in the email


    Set chartsSheet = Sheets("Defects")
    Set chartsSheet2 = Sheets("Test Execution (Manual)")
    Set chartsSheet3 = Sheets("Ageing JIRAs")
    Set chartsSheet4 = Sheets("JIRA_List")
    Set chartsSheet5 = Sheets("Summary-Guidelines")
    
Set rng = Sheets("Summary-Guidelines").Range("B7:E12").SpecialCells(xlCellTypeVisible)
Set rng1 = Sheets("Summary-Guidelines").Range("B23:F36").SpecialCells(xlCellTypeVisible)
Set rng2 = Sheets("Test Execution (Manual)").Range("A57:L63").SpecialCells(xlCellTypeVisible)
Set rng3 = Sheets("Defects").Range("A60:F63").SpecialCells(xlCellTypeVisible)
Set rng4 = Sheets("JIRA_List").Range("A10:P175").SpecialCells(xlCellTypeVisible)


Set rng5 = Sheets("Summary-Guidelines").Range("Overall_Test_Status").SpecialCells(xlCellTypeVisible)




If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If


With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Dim strbody As String
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)
 
    strbody = "<HTML><BODY>"
    strbody = strbody & "<A href=https://teams.income.com.sg/sites/improject/BI/eCommerce/_layouts/15/start.aspx#/Project%20Management%20Documents/Forms/AllItems.aspx?RootFolder=%2Fsites%2Fimproject%2FBI%2FeCommerce%2FProject%20Management%20Documents%2F02%2E%20Project%20Progress%20Reports%2FTRAVEL%20%2D%20UAT%20%2D%20Cycle%201%20%2D%20Progress%20Report&FolderCTID=0x012000EAB27D1B6BF8064B876182D9D0B475F7&View=%7B6FB45BFE%2D53C9%2D4F12%2DB878%2D4D6F496D3AE8%7D>URL Text</A>"
    strbody = strbody & "</BODY></HTML>"
    
With outMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = Sheets("Summary-Guidelines").Range("C4").Value & " - " & Sheets("Summary-Guidelines").Range("C5").Value & " - " & "Status as of " & Format(Date, "dd/mm/yyyy")
    .HTMLBody = RangetoHTML(rng) & RangetoHTML4(rng5) & RangetoHTML0(rng1) & strbody & RangetoHTML1(rng2) & RangetoHTML2(rng3) & RangetoHTML3(rng4) '& Insert_Resized_Chart(chartsSheet)
   
    .Display
End With




With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With


Set outMail = Nothing
Set outApp = Nothing
    
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)    
    Set wEditor = outApp.ActiveInspector.WordEditor
   Set wRange = wEditor.Application.ActiveDocument.Content
        
   wRange.Collapse 1 'Direction:=wdCollapseStart
    
    wRange.InsertAfter " " & vbNewLine
    wRange.Collapse 0 'Direction:=wdCollapseEnd
    
    With chartsSheet2.ChartObjects("Chart 1").Parent
    Set chartObj = chartsSheet2.ChartObjects("Chart 1")
    Insert_Resized_Chart chartObj, chartWidthCm, chartHeightCm, wRange
    chartObj.Height = 200
    chartObj.Width = 450
   wRange.Collapse 0 'Direction:=wdCollapseEnd
        End With
        
     With chartsSheet.ChartObjects("Chart 2").Parent
    Set chartObj = chartsSheet.ChartObjects("Chart 2")
    
    Insert_Resized_Chart chartObj, chartWidthCm, chartHeightCm, wRange
    chartObj.Height = 300
    chartObj.Width = 650
    End With
    
    With chartsSheet.ChartObjects("Chart 3").Parent
    Set chartObj = chartsSheet.ChartObjects("Chart 3")
    Insert_Resized_Chart chartObj, chartWidthCm, chartHeightCm, wRange
    wRange.InsertParagraphAfter
    wRange.InsertAfter "" 
    wRange.Collapse 0 'Direction:=wdCollapseEnd
    
    chartObj.Height = 320
    chartObj.Width = 420
    End With
              
    With chartsSheet.ChartObjects("Chart 1").Parent
    Set chartObj = chartsSheet.ChartObjects("Chart 1")
    Insert_Resized_Chart chartObj, chartWidthCm, chartHeightCm, wRange
   chartObj.Height = 300
    chartObj.Width = 650
    End With
        
    With chartsSheet3.ChartObjects("Chart 1").Parent
    Set chartObj = chartsSheet3.ChartObjects("Chart 1")
    Insert_Resized_Chart chartObj, chartWidthCm, chartHeightCm, wRange
    wRange.InsertParagraphAfter
    wRange.InsertAfter "" '& Time & vbNewLine
    wRange.Collapse 0 'Direction:=wdCollapseEnd
   chartObj.Height = 320
    chartObj.Width = 420
    End With
 
End Sub
Private Sub Insert_Resized_Chart(thisChartObject As ChartObject, newWidthCm As Single, newHeightCm As Single, wordRange As Object)


thisChartObject.Chart.ChartArea.Copy    wordRange.PasteSpecial , , , , 4 'DataType:=wdPasteBitmap
   
End Sub
222.jpg2323.jpg