macro to copy from excel & jpg files to word doc?

[mopgcw]

i have constructed a macro to do the following:

in the master excel sheet, open the specified collateral excel sheets; copy
a named range to the word document; then insert the two jpegs (names obtained
from the opened collateral excel sheet) ; then return to the open collateral
excel sheet and copy the second named range to the word document. close this
collateral file and repeat with the next collateral file.

the order is imporant to the presentation in the word document.

i am working in excel 2003.

the result is a little odd in that the linked range names that are pasted
into word are appearing as:

{LINK Excel.Sheet.8 "\\\\ukfsts001\\PREFCO\\Active
Transactions\\GERMANY\\arsago 2 aggregation 7.07\\UW\\test\\test3\\aww.xlsâ€
"myrangename_1" \a\p}

as opposed to the ole object image. If i copy the above and paste as a
bitmap it shows up correctly but i lose the update link ability which is
crucial. if i double click, it opens the link as it should, so it is
functional but not displaying correctly.

the jpegs display properly.

i am at a loss, so would appreciate any ideas.


Sub icmemo()

' ==============================
' 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

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

'Release Word object
Set wdApp = Nothing

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

End Sub

 

[Shauna Kelly]

Hi

Do Alt-F9. Does that solve the problem?

If so you need to turn off the display of field codes and instead dispay
field results. You do that at Tools > Options > View. Un-tick the "Field
codes" box.

I do not generally recommend that you include this in the code, since that's
a user setting and a user might have a good reason to display codes or
display fields, and won't thank you for changing their setting.

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

 

[mopgcw]

Perfect! Thanks for the pointer. never heard of this detail before. i dont
know how this got flipped in the first place.

take care
george

 

[Russ]

See in previous text, a reply.

Hi

Do Alt-F9. Does that solve the problem?

If so you need to turn off the display of field codes and instead dispay
field results. You do that at Tools > Options > View. Un-tick the "Field
codes" box.

I do not generally recommend that you include this in the code, since that's
a user setting and a user might have a good reason to display codes or
display fields, and won't thank you for changing their setting.

I agree that if you must change an option in code, then you should save its
current setting, do your processing; and restore the setting when finished
as a courtesy to the user. If you follow that procedure, then you should be
able to change options in code.

 

[Russ]

Addendum in previous text.

See in previous text, a reply.

I agree that if you must change an option in code, then you should save its
current setting, do your processing; and restore the setting when finished
as a courtesy to the user. If you follow that procedure, then you should be
able to change options in code.

One reason to change options in code is to ensure a 'known good state' for
reliable macro execution, as was probably needed in this case.