Unable to change properties when I paste chart from excel to word

Hi

I have created word document with help of excel.

On another side I have created chart in Excel.

with help of excel vba I want to copy graphs in excel to paste it to word as picture. till this I'm able to do successful coding.

Now problem starts here: after pasting picture, I need to set properties with pasted picture i.e. height, width, inline or behind text ,etc

'Code for copying from excel
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = CreateObject("Word.Application")
With WordApp
        .Visible = True
        Set WordDoc = .Documents.Add
End With

with wordapp.selection  

With Workbooks("Report.xlsx")
.Activate
.Sheets("ActiveStats").Select
With ActiveSheet.ChartObjects("Chart 3")
.Activate
.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
End With

'Goto Line number in word
.Goto What:=wdGoToLine, Which:=wdGoToNext, Count:=1
.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdFloatOverText, Link:=False, DisplayAsIcon:=False, IconIndex:=1

'setting properties with pasted picture in word
With WordApp.ActiveDocument.Shapes(2)   '<<-----My code get stops here and gives various error numbers 5941, 462 ,etc) tried with shaperange and Inlineshape none work------<<
.AlternativeText = "1.2: Incident Comparison Summary"
.WrapFormat.Type = wdWrapInline
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.LockAspectRatio = msoFalse
.Width = 504
.Height = 216
End With


end with

Please help me. Note I have atleast 20 graphs and need to be pasted as picture/image. Secondly is there is any way that I can set Shapes index number. the error occurs due the shape number not found.
Alternative option is to export chart from excel and then insert to word which becomes complex so I can't use it.


Then I tried with For Next loop...Code runs perfectly, but one problem still I'm Facing.

I add logo of my company on first page. Then from 4th page I start pasting my excel Charts to word application.

While pasting first chart it applies settings to first page first image than it goes to second image and so on thill last.

'<-------Image logo------>
With WordApp.ActiveDocument.InlineShapes.AddPicture(Filename:="C:\Users\socadmin\Desktop\123.png", LinkToFile:=False, SaveWithDocument:=True).ConvertToShape
.Name = "BankofMaharashtra"
.WrapFormat.Type = wdWrapFront
.WrapFormat.AllowOverlap = False
.WrapFormat.Side = wdWrapBoth
.LockAspectRatio = msoFalse
.Left = wdShapeCenter
.Width = 504
.Height = 206
'.Top = InchesToPoints(0.5)
.AlternativeText = "Bank of Maharashtra"
With .Shadow
.Visible = msoCTrue
.Blur = 4
.Transparency = 0.6
.OffsetX = 3.5
.OffsetY = 3.5
.Style = msoShadowStyleOuterShadow
End With
.SoftEdge.Type = msoSoftEdgeType2
End With

'.few codes in between that are not related to Image
.
.
.
.
.
.

call copycharters

Activedocument.Save

End Sub


sub copycharters()
For i = 1 To WordApp.ActiveDocument.Shapes.Count Step 2

With WordApp.Selection

.Goto What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=4
.Goto What:=wdGoToLine, Which:=wdGoToNext, Count:=2
.Style = ("SubChapters")
.TypeText Text:="Summary one" & vbCrLf
.Style = ("No Spacing")

With Workbooks("Charting.xlsx")  '<---Copy from Excel  first Chart--->
.Activate
.Sheets("ArcStat").Select
With ActiveSheet.ChartObjects("Chart 2")
.Activate
.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
End With
.Goto What:=wdGoToLine, Which:=wdGoToNext, Count:=1
.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine, Link:=False, DisplayAsIcon:=False

With WordApp.ActiveDocument.Shapes(i) '<----These settings for 1st chart image get applied to logo that is of first page of word document---->
.Name = "1"
.AlternativeText = "Chart 2"
.WrapFormat.Type = wdWrapInline
.WrapFormat.AllowOverlap = False
.WrapFormat.Side = wdWrapBoth
.LockAspectRatio = msoFalse
.Width = 504
.Height = 180
End With
.TypeText Text:=vbCrLf



.Goto What:=wdGoToLine, Which:=wdGoToNext, Count:=1
.Style = ("SubChapters")
.TypeText Text:="Summary 2"& vbCrLf
.Style = ("No Spacing")
With Workbooks("Charting.xlsx")   '<---Copy from Excel  second Chart--->
.Activate
.Sheets("ArcStat").Select
With ActiveSheet.ChartObjects("Chart 4")
.Activate
.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
End With
.Goto What:=wdGoToLine, Which:=wdGoToNext, Count:=1
.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdFloatOverText, Link:=False, DisplayAsIcon:=False


With WordApp.ActiveDocument.Shapes(i) '<----'from here it works perfectly----->
.Name = "2"
.AlternativeText = "Chart 4"
.WrapFormat.Type = wdWrapInline
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.LockAspectRatio = msoFalse
.Width = 504
.Height = 180
End With
.TypeText Text:=vbCrLf


.
.
.
.
.
.
.
'<----Similarly it works for 45 charts rest works properly except for first chart------>

Next i

End Sub

Due to this image positions get change.