2 ? macro - insert a table one line below a bookmark & Pics to tab

G

Guest

I have the following macro to insert a table into a word document at a
bookmark.

I need to re-use this bookmark to insert other information in a loop, so
once the table "takes-over" the book mark, the information following is all
put in the table, which is a mess.

How do i insert the table one line below the bookmark, thus keeping the
bookmark free to insert the other information?

And secondly, how do I insert the two jpgs to the table, as opposed to the
bookmark?

Appreciate any help.

Thanks
george

Here is the code:

'Copy the 1st table from the Excel Sheet IC MEMO

Range("ic_memo2").Copy

'Open IC Memo in Word

With ActiveDocument
If .Bookmarks.Exists(bookmarkname1) Then

.Bookmarks(bookmarkname1).Range.PasteSpecial Link:=True,
DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False

.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertParagraph

For Each oShape In ActiveDocument.InlineShapes
With oShape
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(14.68)
.Height = CentimetersToPoints(6.77)
End With
Next oShape

Dim prange As Word.Range

Set prange = ActiveDocument.Bookmarks(bookmarkname1).Range

ActiveDocument.Tables.Add Range:=prange, NumRows:=1,
NumColumns:=2, _
DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed

Set ilsPic =
ActiveDocument.InlineShapes.AddPicture(Filename:=ic_photo1, _
LinkToFile:=False, SaveWithDocument:=True, _
Range:=prange)

.Bookmarks(bookmarkname1).Range.InsertParagraph

Set ilsPic =
ActiveDocument.InlineShapes.AddPicture(Filename:=ic_photo2, _
LinkToFile:=False, SaveWithDocument:=True, _
Range:=prange)

Dim pShape As InlineShape

For Each pShape In ActiveDocument.InlineShapes
With pShape
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(4.68)
.Height = CentimetersToPoints(6.77)
End With
Next pShape

.Save
Else
MsgBox "Bookmark: " & bookmarkname1 & " not found."
End If
End With

Windows(collatfile).Activate

Range("ic_memo1").Copy

'Open IC Memo in Word

With ActiveDocument

If .Bookmarks.Exists(bookmarkname1) Then

.Bookmarks(bookmarkname1).Range.PasteSpecial Link:=True,
DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False

.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertAfter (stext3) + Chr(13)
.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertAfter (stext2) + Chr(13)
.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertAfter (stext1) + Chr(13)
.Bookmarks(bookmarkname1).Range.InsertParagraph

Dim oShape2 As InlineShape
For Each oShape2 In ActiveDocument.InlineShapes
With oShape2
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(14.68)
.Height = CentimetersToPoints(6.77)
End With
Next oShape2

.Save
Else
MsgBox "Bookmark: " & BookMarkName2 & " not found."
End If
End With

' ================================
' go to collateral file and close
' ================================

Range("A1").Copy ' JUST TO CLEAR CLIPBOARD

Windows(collatfile).Activate

ActiveWorkbook.Close savechanges:=False

end If
Next Collatloop

Set wdapp = nothing

end sub
 
G

Guest

I updated the code as follows, but get an error code 450 too many arguments
or wrong properties at the add tables part....

here is the update:


'Copy the table from the Excel Sheet IC MEMO

Range("ic_memo2").Copy

'Open IC Memo in Word

With ActiveDocument
If .Bookmarks.Exists(bookmarkname1) Then

.Bookmarks(bookmarkname1).Range.PasteSpecial Link:=True,
DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False

.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertParagraph

For Each oShape In ActiveDocument.InlineShapes
With oShape
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(14.68)
.Height = CentimetersToPoints(6.77)
End With
Next oShape

Dim prange As Word.Range

Set prange = ActiveDocument.Bookmarks(bookmarkname1).Range

With ActiveDocument
.Goto what:=wdGoToBookmark, Name:=bookmarkname1
Word.Selection.MoveDown Unit:=wdLine, Count:=1

ActiveDocument.Tables.Add Range:=Selection.Range,
NumRows:=1, NumColumns:=2, _
DefaultTableBehavior:=wdWord9TableBehavior,
AutoFitBehavior:= _
wdAutoFitFixed

With Selection.Tables(1)
.Columns.PreferredWidth = CentimetersToPoints(8)

If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If

.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With

Set ilsPic = ActiveDocument.InlineShapes.AddPicture
(Filename:=ic_photo1, _
LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)

Selection.MoveRight Unit:=wdCharacter, Count:=1

Set ilsPic =
ActiveDocument.InlineShapes.AddPicture(Filename:=ic_photo2, _
LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)

'Dim pShape As InlineShape

'For Each pShape In ActiveDocument.InlineShapes
'With pShape
' .LockAspectRatio = msoTrue
'.Width = CentimetersToPoints(4.68)
'.Height = CentimetersToPoints(6.77)
'End With
'Next pShape

End With

.Save
Else
MsgBox "Bookmark: " & bookmarkname1 & " not found."
End If
End With

Windows(collatfile).Activate

Range("ic_memo1").Copy

'Open IC Memo in Word

With ActiveDocument

If .Bookmarks.Exists(bookmarkname1) Then

.Bookmarks(bookmarkname1).Range.PasteSpecial Link:=True,
DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False

.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertAfter (stext3) + Chr(13)
.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertAfter (stext2) + Chr(13)
.Bookmarks(bookmarkname1).Range.InsertParagraph
.Bookmarks(bookmarkname1).Range.InsertAfter (stext1) + Chr(13)
.Bookmarks(bookmarkname1).Range.InsertParagraph

Dim oShape2 As InlineShape
For Each oShape2 In ActiveDocument.InlineShapes
With oShape2
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(14.68)
.Height = CentimetersToPoints(6.77)
End With
Next oShape2

.Save
Else
MsgBox "Bookmark: " & BookMarkName2 & " not found."
End If
End With

' ================================
' go to collateral file and close
' ================================

Range("A1").Copy ' JUST TO CLEAR CLIPBOARD

Windows(collatfile).Activate

ActiveWorkbook.Close savechanges:=False

End If

Next Collatloop

'Release Word object
Set wdApp = Nothing

MsgBox ("IC Memo from " + WorksheetFunction.Text(collatincluded, "0") + "
collateral files populated for Francis")

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with Macro Error Message? 3
macro to copy from excel range to word doc 1

Top