M
mopgcw
I cannot understand why I am getting an error 450 -- wrong number of
arguments or invalid property assignment -- in this macro where the table is
being created in Word. When i run just that section in Word, it seems to
work fine.
I would greatly appreciate help in figuring this out.
thanks
george
Sub F1()
' ==============================
' Define Variables
' ==============================
Dim poolfile As String
Dim collatfile As String
Dim Theresponse As String
Dim stext1 As String
Dim stext2 As String
Dim stext3 As String
Dim numcollat As Integer
Dim Collatloop As Integer
Dim collatincluded As Integer
Dim wdApp As Word.Application
Dim oDoc As Word.Document
Dim WdDoc As String
Dim BookMarkName As String
Dim ic_photo1 As String
Dim ic_photo2 As String
Dim ilsPic As Word.InlineShape
photolocation = ActiveWorkbook.Path
' ==============================
' Initialize Variables
' ==============================
poolfile = ActiveWorkbook.Name
WdDoc = Range("ic_memo_filename").Value + ".doc"
collatincluded = 0
Application.ScreenUpdating = False
numcollat = WorksheetFunction.Max(Range("array_collatfilenum").Value)
bookmarkname1 = "collat_table1"
stext1 = "Location, Access & Visibility "
stext2 = "Engineering and Environmental "
stext3 = "Market "
' Sort the collateral file names for the iteration from smallest to largest
Windows(poolfile).Activate
Range("ic_memo_array").Select
Selection.Sort Key1:=Range("E3"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Dir(WdDoc) <> "" Then
Theresponse = MsgBox(WdDoc + " exists: Do you want to add these tables
too?", vbYesNo + vbCritical + vbDefaultButton2, _
"ARE YOU POSITIVE?")
If Theresponse = vbNo Then
MsgBox "Export Terminated"
Exit Sub
End If
Set wdApp = New Word.Application
wdApp.Visible = False
Set oDoc = wdApp.Documents.Open(WdDoc)
Else
MsgBox "File: " & WdDoc & " not found."
End If
' ==============================
' Loop through each collat file
' ==============================
For Collatloop = 1 To numcollat
If Range("array_collatfileinclude").Cells(Collatloop) = 1 Then
'============================
'Open the collat file
'============================
Workbooks.Open
Filename:=Range("array_collatfilename").Cells(Collatloop)
collatfile = ActiveWorkbook.Name
collatincluded = collatincluded + 1
'========================================
'Go to Collat File & Copy Data
'========================================
Windows(collatfile).Activate
ic_photo1 = photolocation + "\fotos\" + Range("ic_photo1").Value +
".jpg"
ic_photo2 = photolocation + "\fotos\" + Range("ic_photo2").Value +
".jpg"
'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
Word.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
arguments or invalid property assignment -- in this macro where the table is
being created in Word. When i run just that section in Word, it seems to
work fine.
I would greatly appreciate help in figuring this out.
thanks
george
Sub F1()
' ==============================
' Define Variables
' ==============================
Dim poolfile As String
Dim collatfile As String
Dim Theresponse As String
Dim stext1 As String
Dim stext2 As String
Dim stext3 As String
Dim numcollat As Integer
Dim Collatloop As Integer
Dim collatincluded As Integer
Dim wdApp As Word.Application
Dim oDoc As Word.Document
Dim WdDoc As String
Dim BookMarkName As String
Dim ic_photo1 As String
Dim ic_photo2 As String
Dim ilsPic As Word.InlineShape
photolocation = ActiveWorkbook.Path
' ==============================
' Initialize Variables
' ==============================
poolfile = ActiveWorkbook.Name
WdDoc = Range("ic_memo_filename").Value + ".doc"
collatincluded = 0
Application.ScreenUpdating = False
numcollat = WorksheetFunction.Max(Range("array_collatfilenum").Value)
bookmarkname1 = "collat_table1"
stext1 = "Location, Access & Visibility "
stext2 = "Engineering and Environmental "
stext3 = "Market "
' Sort the collateral file names for the iteration from smallest to largest
Windows(poolfile).Activate
Range("ic_memo_array").Select
Selection.Sort Key1:=Range("E3"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Dir(WdDoc) <> "" Then
Theresponse = MsgBox(WdDoc + " exists: Do you want to add these tables
too?", vbYesNo + vbCritical + vbDefaultButton2, _
"ARE YOU POSITIVE?")
If Theresponse = vbNo Then
MsgBox "Export Terminated"
Exit Sub
End If
Set wdApp = New Word.Application
wdApp.Visible = False
Set oDoc = wdApp.Documents.Open(WdDoc)
Else
MsgBox "File: " & WdDoc & " not found."
End If
' ==============================
' Loop through each collat file
' ==============================
For Collatloop = 1 To numcollat
If Range("array_collatfileinclude").Cells(Collatloop) = 1 Then
'============================
'Open the collat file
'============================
Workbooks.Open
Filename:=Range("array_collatfilename").Cells(Collatloop)
collatfile = ActiveWorkbook.Name
collatincluded = collatincluded + 1
'========================================
'Go to Collat File & Copy Data
'========================================
Windows(collatfile).Activate
ic_photo1 = photolocation + "\fotos\" + Range("ic_photo1").Value +
".jpg"
ic_photo2 = photolocation + "\fotos\" + Range("ic_photo2").Value +
".jpg"
'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
Word.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