Problems with Word VBA automation

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Edward - 09 Jan 2006 17:02 GMT

I have two problems.

1) I am copying shapes from Excel 2000 to Word 2000. I am trying to
PasteSpecial as EMF and Placement:=wdInLine but the shapes do not copy as
InLine. They become stacked on top of each other eventually causing the
macro to abort. Am I missing a parameter?

2) When I Quit the Excel object a residual Excel is running in Task Manager.
How do I completely close down the Excel object?

Reply to this Message

Cindy M -WordMVP- - 10 Jan 2006 10:17 GMT

Hi =?Utf-8?B?RWR3YXJk?=,

> 1) I am copying shapes from Excel 2000 to Word 2000. I am trying to
> PasteSpecial as EMF and Placement:=wdInLine but the shapes do not copy as
> InLine. They become stacked on top of each other eventually causing the
> macro to abort. Am I missing a parameter?
>

If these are Shapes (as in Drawing tools) then they cannot be placed in-line
with the text. Shapes simply do not support this in Office 2000. If you were to
paste them as a bitmap, you might have a chance. But I think EMF is too close
to their original graphics format.

> 2) When I Quit the Excel object a residual Excel is running in Task Manager.
> How do I completely close down the Excel object?

Impossible to do more than guess without seeing the code. The usual reason is
that your code leaves an orphaned pointer: you haven't set all the Excel object
variables to Nothing, or not in the correct order.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail :-)

Reply to this Message

Edward - 10 Jan 2006 14:50 GMT

Cindy,

If you could take a look at the code and comment.

Option Explicit

Private xlsObject As Object

Private Sub UserForm_Initialize()

Dim strFilename As String
Dim wsWorksheet As Worksheet

Set xlsObject = CreateObject("Excel.Application")
strFilename = xlsObject.GetOpenFilename()

If strFilename = "False" Then
MsgBox "Cancelled!"
Exit Sub
End If

xlsObject.Workbooks.Open FileName:=strFilename

For Each wsWorksheet In xlsObject.Worksheets
If InStr(wsWorksheet.Name, "Plot_") > 0 Then
lbExcelPlotSheets.AddItem wsWorksheet.Name
End If
Next

End Sub

Private Sub UserForm_Terminate()
xlsObject.Quit
Set xlsObject = Nothing
End Sub

Private Sub btnOkay_Click()

Dim i As Long
Dim wsWorksheet As Worksheet
Dim rRange As Range

For i = 0 To lbExcelPlotSheets.ListCount - 1
If lbExcelPlotSheets.Selected(i) Then
' xlsObject.Selection.Clear
Set wsWorksheet = xlsObject.Worksheets(lbExcelPlotSheets.List(i))
wsWorksheet.Activate
wsWorksheet.Shapes.SelectAll
xlsObject.Selection.Copy
Set rRange = ActiveDocument.Sections(1).Range
With rRange
.MoveEnd Unit:=wdCharacter, Count:=-1
.Collapse Direction:=wdCollapseEnd
.InsertParagraphAfter
.InsertAfter " "
.InsertBreak wdPageBreak
End With
rRange.PasteSpecial Placement:=wdInLine,
DataType:=wdPasteEnhancedMetafile
End If
Next

End Sub

Reply to this Message

Edward - 10 Jan 2006 17:40 GMT

As a further note. If I run the macro it aborts after inserting one picture.
If I single step through the code it will add 35 pictures and then abort.

Reply to this Message

Nick Hebb - 11 Jan 2006 19:12 GMT

I'm am currently working on something similar to this. So I feel your
pain.

A couple of points:

1. Change "Dim rRange as Range" to "Dim rRange as Word.Range" since the
the Range object exists in both Word and Excel. Your Set statement
should take care of any scope resolutions issues, but it's just a good
habit for the long term readability of the code.

2. Try xlsObject.Selection.Group before your xlsObject.Selection.Copy.
This will copy it as a single picture and should take care of the
stacking issues. Follow it with a xlsObject.Selection.Ungroup.

3. I really don't understand what you're trying to do here:
Set xlsObject = CreateObject("Excel.Application")
strFilename = xlsObject.GetOpenFilename()

If strFilename = "False" Then
MsgBox "Cancelled!"
Exit Sub
End If

xlsObject.Workbooks.Open FileName:=strFilename

To test if Excel is already open, and if not, create a new instance,
the code would look something like the following:

Dim wb As Excel.Workbook

On Error Resume Next
Set xlsObject = GetObject(, "Excel.Application")
If Err.Number = 429 Then
Set xlsObject = CreateObject("Excel.Application")
xlsObject.Visible = True
Else
Set wb = xlsObject.ActiveWorkbook
End If

Note that I added the "Dim wb as Excel.Workbook" line. With your
original code, I'm not sure what would happen if there were multiple
workbooks (Excel files) open. I think it would iterate through all the
sheets in all the open Excel files.

4. "If I run the macro it aborts after inserting one picture. If I
single step through the code it will add 35 pictures and then abort."

I get this problem all the time. Adding error handling certainly helps,
but I still see inconsistent behavior like this from time to time.

HTH,

Nick Hebb
BreezeTree Software, LLC
http://www.breezetree.com

Reply to this Message

Edward - 11 Jan 2006 19:51 GMT

Nick,

No luck. I try to group the Excel shapes but the paste is not the picture I
expect, just a small box.

I tried to remove the Placement:=wdInLine. It turns out the paste is as
picture. I get the last shape inserted and convert to inline. This works
but still the macro aborts after 1 picture. It must be something to do with
the Word Range I set but I've tried all types of permutation with no luck.

In answer to your question, I don't have Excel open. I just use the Open
File Dialog box to get the Excel filename. I then connect to it and start
extracting graphics.

I have been programming Excel VBA for years and can manage pretty well.
Word is an all together different animal.

Reply to this Message

Edward - 12 Jan 2006 19:30 GMT

Nick,

I found article 275558 at Microsoft web site. I got my macro to work
finally. This may help you. See my reply to Cindy.

Reply to this Message

Nick Hebb - 13 Jan 2006 06:59 GMT

Edward, thanks for the tip. I hadn't received that error yet, so better
to find out now instead of after I released the software.

Reply to this Message

Cindy M -WordMVP- - 12 Jan 2006 10:15 GMT

Hi =?Utf-8?B?RWR3YXJk?=,

> If I run the macro it aborts after inserting one picture.
> If I single step through the code it will add 35 pictures and then abort.

Can you be more specific about "abort"? Do you get any error messages? Or
does the code just exit when moving from one line to the next? At which line
does execution stop?

As I said, some things cannot be pasted in-line. Try using just plain old
Paste and see if you get more predictable results.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail :-)

Reply to this Message

Edward - 12 Jan 2006 15:26 GMT

Cindy,

I get runtime 4198 "Command failed". It occurs at the second PasteSpecial.

I detected that the paste was as msoPicture. I have modified the code to
PasteSpecial without Placement and then get the last shape inserted and
ConvertToInlineShape. That works but the macro still aborts.

I suspect it has something to do with the range. But I'm new to Word VBA
and can't quite comprehend the range. I am proficient in Excel VBA. I have
tried all types of range permutations without success.

Reply to this Message

Edward - 12 Jan 2006 15:49 GMT

Cindy,

Your question prompted me to check the Microsoft site and found the
following article 275558. I have modified the code as shown below and it is
working. Thanks.

Private Sub btnOkay_Click()

Dim i As Long
Dim wsWorksheet As Worksheet
Dim rRange As Word.Range
Dim sShape As Word.Shape

Set rRange = ActiveDocument.Characters(1)

For i = 0 To lbExcelPlotSheets.ListCount - 1
If lbExcelPlotSheets.Selected(i) Then
' xlsObject.Selection.Clear
Set wsWorksheet = xlsObject.Worksheets(lbExcelPlotSheets.List(i))
wsWorksheet.Activate
wsWorksheet.Shapes.SelectAll
xlsObject.Selection.Copy
rRange.Select ' <- This does the trick
Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile
Set sShape = ActiveDocument.Shapes(ActiveDocument.Shapes.Count)
sShape.ConvertToInlineShape
Set rRange = ActiveDocument.Sections(1).Range
With rRange
.MoveEnd Unit:=wdCharacter, Count:=-1
.Collapse Direction:=wdCollapseEnd
.InsertParagraphAfter
.InsertBreak wdPageBreak
End With
End If
Next

End Sub

Reply to this Message