clif
09-22-2016, 01:48 AM
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
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