resize word pictures

[clif]

I cannot successfully reszie the pictures, what is the problem here?

Sub abc()
 Dim wb As Workbook
 Dim ws As Worksheet
 
 Dim wrdApp As Word.Application
 Dim wrdDoc As Document
 
'assign object values
 Set wb = ThisWorkbook
 Set ws = wb.Sheets("data")
 
 Set wrdApp = CreateObject("Word.Application")
 Set wrdDoc = wrdApp.Documents.Open("C:\Users\abc.doc")
'Run Word on the background
 wrdApp.Visible = True
 wrdDoc.Activate
 
 Dim a As Integer
 Dim b As String
 Dim c As String
 Dim d As String
 Dim e As String
  Dim g As String
  Dim h As String
  Dim i As String
 Dim f As Integer
   f = 2
   
 For a = Sheets("Data").Cells(2, 11).Value + Sheets("Data").Cells(1, 11).Value To Sheets("Data").Cells(3, 11).Value + Sheets("Data").Cells(1, 11) '.Value
  
 b = "a" & CStr(f - 1)
 c = "b" & CStr(f - 1)
 d = "c" & CStr(f - 1)
 e = "d" & CStr(f - 1)
 g = "e" & CStr(f - 1)
 h = "f" & CStr(f - 1)
  i = "i" & CStr(f - 1)
 
 wrdApp.Selection.Goto wdGoToBookmark, , , b
 wrdApp.Selection.TypeText Text:=ws.Cells(a, 1).Value
 
  wrdApp.Selection.Goto wdGoToBookmark, , , c
 wrdApp.Selection.TypeText Text:=ws.Cells(a, 2).Value
 
  wrdApp.Selection.Goto wdGoToBookmark, , , d
 wrdApp.Selection.TypeText Text:=ws.Cells(a, 3).Value
 
  wrdApp.Selection.Goto wdGoToBookmark, , , e
 wrdApp.Selection.TypeText Text:=ws.Cells(a, 4).Value
 
  wrdApp.Selection.Goto wdGoToBookmark, , , g
 wrdApp.Selection.TypeText Text:=ws.Cells(a, 5).Value
 
  wrdApp.Selection.Goto wdGoToBookmark, , , h
 wrdApp.Selection.TypeText Text:=ws.Cells(a, 7).Value

  wrdApp.Selection.Goto wdGoToBookmark, , , i
    wrdApp.Shapes.AddPicture Filename:=ws.Cells(a, 6).Value, _
    LinkToFile:=False, _
    SaveWithDocument:=True, _
    Left:=-5, _
    Top:=5, _
    Anchor:=Selection.Range, _
    Width:=20, _
    Height:=20
 
 f = f + 1
Next a

wrdDoc.Close
wrdApp.Quit
 

 Set wrdDoc = Nothing
 Set wrdApp = Nothing
 Set ws = Nothing
 Set wb = Nothing
 

End Sub

I try this but not successful

 wrdApp.Selection.Goto wdGoToBookmark, , , i
    wrdApp.Selection.InlineShapes.AddPicture Filename:=ws.Cells(a, 6).Value, _
    LinkToFile:=False, _
    SaveWithDocument:=True, _
    Left:=-5, _
    Top:=5, _
    Anchor:=Selection.Range, _
    Width:=20, _
    Height:=20

[snb]

I cannot succesfully open your sample document. Why not ?

[mana]

please try this

> wrdApp.Shapes.AddPicture

wrdDoc.Shapes.AddPicture

[mana]

testing code

Sub test()
    Dim wrdApp As Object
    Dim wrdDoc As Object
       
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Open(ThisWorkbook.Path & "\abc.docx")

    wrdDoc.Shapes.AddPicture Filename:=Cells(1, 6).Value, _
    LinkToFile:=False, _
    SaveWithDocument:=True, _
    Left:=-5, _
    Top:=5, _
    Anchor:=wrdApp.Selection.Range, _
        Width:=20, _
        Height:=20
   
    Set wrdDoc = Nothing
    Set wrdApp = Nothing


End Sub