PDA

View Full Version : [SOLVED] resize word pictures



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

snb
09-22-2016, 02:11 AM
I cannot succesfully open your sample document. Why not ?

mana
09-22-2016, 03:39 AM
please try this

> wrdApp.Shapes.AddPicture

wrdDoc.Shapes.AddPicture

mana
09-22-2016, 04:29 AM
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