M
mopgcw
Thanks to macropod and others, i cobbled together the following code to copy
a specific range from a set of excel files to a specific word document. The
problem i have, is how to insert a paragraph break in word in between each of
the excel ranges after they are pasted into word, otherwise it defeats the
purpose since i would have to cut and paste again to create the necessary
room to add comments in the word doc.
tia for any help.
regards.
george
Sub Francis()
' ==============================
' Define Variables
' ==============================
Dim loanfile As String
Dim collatfile As String
Dim numcollat As Integer
Dim Collatloop As Integer
Dim collatincluded As Integer
Dim wdApp As Word.Application
Dim WdDoc As String
' ==============================
' Initialize Variables
' ==============================
WdDoc = Range("ic_memo_filename").Value + ".doc"
collatincluded = 0
Application.ScreenUpdating = False
numcollat = WorksheetFunction.Max(Range("array_collatfilenum").Value)
loanfile = ActiveWorkbook.Name
' ==============================
' 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
'Copy the table from the Excel Sheet IC MEMO
Range("ic_memo1").Copy
'Open IC Memo in Word
If Dir(WdDoc) <> "" Then
Set wdApp = New Word.Application
wdApp.Visible = False
With wdApp
'open the Word Document
Documents.Open Filename:=WdDoc
With wdApp
Dim BookMarkName As String
BookMarkName = "collat_table"
With ActiveDocument
If .Bookmarks.Exists(BookMarkName) Then
.Bookmarks(BookMarkName).Range.PasteSpecial Link:=True,
DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
Dim oShape As InlineShape
For Each oShape In ActiveDocument.InlineShapes
With oShape
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(16.4)
.Height = CentimetersToPoints(15.5)
End With
Next oShape
.Save
Else
MsgBox "Bookmark: " & BookMarkName & " not found."
End If
End With
End With
End With
Else
MsgBox "File: " & WdDoc & " not found."
End If
' ================================
' go to 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 created for Francis")
End Sub
a specific range from a set of excel files to a specific word document. The
problem i have, is how to insert a paragraph break in word in between each of
the excel ranges after they are pasted into word, otherwise it defeats the
purpose since i would have to cut and paste again to create the necessary
room to add comments in the word doc.
tia for any help.
regards.
george
Sub Francis()
' ==============================
' Define Variables
' ==============================
Dim loanfile As String
Dim collatfile As String
Dim numcollat As Integer
Dim Collatloop As Integer
Dim collatincluded As Integer
Dim wdApp As Word.Application
Dim WdDoc As String
' ==============================
' Initialize Variables
' ==============================
WdDoc = Range("ic_memo_filename").Value + ".doc"
collatincluded = 0
Application.ScreenUpdating = False
numcollat = WorksheetFunction.Max(Range("array_collatfilenum").Value)
loanfile = ActiveWorkbook.Name
' ==============================
' 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
'Copy the table from the Excel Sheet IC MEMO
Range("ic_memo1").Copy
'Open IC Memo in Word
If Dir(WdDoc) <> "" Then
Set wdApp = New Word.Application
wdApp.Visible = False
With wdApp
'open the Word Document
Documents.Open Filename:=WdDoc
With wdApp
Dim BookMarkName As String
BookMarkName = "collat_table"
With ActiveDocument
If .Bookmarks.Exists(BookMarkName) Then
.Bookmarks(BookMarkName).Range.PasteSpecial Link:=True,
DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
Dim oShape As InlineShape
For Each oShape In ActiveDocument.InlineShapes
With oShape
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(16.4)
.Height = CentimetersToPoints(15.5)
End With
Next oShape
.Save
Else
MsgBox "Bookmark: " & BookMarkName & " not found."
End If
End With
End With
End With
Else
MsgBox "File: " & WdDoc & " not found."
End If
' ================================
' go to 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 created for Francis")
End Sub