Copying from Excel to Word - Code stops after Paste command line

[frank_AL]

First, let me say this is the first time I have attempted to execute code in a Word document from an Excel code module. I've gotten to this point with a good bit of searching/googling for solutions so thank you to all who post how to get things done!

The code posted below is intended to open a Word doc, find specific text, move to the next line and copy a picture from an Excel file. Since there will be multiple instances, my intent is to open the Word file, the first time the code is executed as defined by the 'chartno' variable, cycle through multiple times until all instances are copied and saved.

Everything seems to be working fine with one exception, when the code line ".Application.Selection.Paste" is executed, the picture does get pasted but the code simply stops at that point. If I manually execute the code and I step over that line of code the file does get saved as expected.

Please help and thanks in advance for your assistance.

Option Explicit

Sub FindText()
Dim sNewFileName As String
Dim FNLngth As Integer
Dim WordFN As String
Dim iApp As Word.Application
Dim iDoc As Word.document
Dim chartno As Integer
Dim CurrCity As String
CurrCity = "New Holland"  '  Manually setting this now in order to test code.  Value will come from module that calls this module


'   Capture Word Doc filename and trim off file extension and assign PDF file name
    If chartno = 1 Then
        Set iApp = CreateObject("Word.Application")
        iApp.Visible = True
        Set iDoc = iApp.Documents.Open("C:\Users\fbatu\Documents\aWork\Commission Program\Tyson Foods Letter Project\10-1-22 Company Letter.docx")
        WordFN = iDoc.FullName
        FNLngth = Len(WordFN) - 5
        WordFN = Left(WordFN, FNLngth)
        sNewFileName = WordFN & " - " & CurrCity & ".pdf"

'   Find text in Word doc and copy Jpeg picture on next line
        With iDoc
            .Application.Selection.Find.Text = "The following pricing changes "
            .Application.Selection.Find.Execute
            .Application.Selection.EndKey Unit:=wdLine
            .Application.Selection.MoveRight
            .Application.Selection.Paste
            .SaveAs2 Filename:=sNewFileName, FileFormat:=wdFormatPDF, AddtoRecentFiles:=False
        End With
    Else
        With iDoc
            .Application.Selection.MoveUp Unit:=wdLine, Count:=10
            .Application.Selection.Find.Text = "The following pricing changes "
            .Application.Selection.Find.Execute
            .Application.Selection.EndKey Unit:=wdLine
            .Application.Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
            .Application.Selection.Delete Unit:=wdCharacter, Count:=1
            .Application.Selection.Paste
            .SaveAs2 Filename:=sNewFileName, FileFormat:=wdFormatPDF, AddtoRecentFiles:=False
        End With
    End If  ' chartno = 1

End Sub

 

[NdNoviceHlp]

Hi frank_AL. You don't seem to be copying anything to paste? Your use of .Application is wrong. It should be...

With iApp.iDoc
.Selection.Find.Text = "The following pricing changes "
'etc.

Search my posts for pasting pictures to Word using PasteSpecial. The code should look something like this...

Sub SaveXlRangeToWordFile()
Dim ObjPic As Object, PFWdApp As Object
On Error GoTo ErFix
Set PFWdApp = CreateObject("Word.Application")
PFWdApp.Documents.Open Filename:="C:\foldername\summary.doc", ReadOnly:=False
PFWdApp.ActiveDocument.Content.PasteSpecial DataType:=3 '9  '4
'pictures in newxl version are converted to inlineshapes
'takes time to paste and convert
Dim t As Double
t = Timer
Do Until Timer - t > 1
  DoEvents
Loop

For Each ObjPic In PFWdApp.ActiveDocument.InlineShapes
ObjPic.ConvertToShape
Next ObjPic

PFWdApp.ActiveDocument.Close savechanges:=True
PFWdApp.Quit
Application.CutCopyMode = False
Set ObjPic = Nothing
Set PFWdApp = Nothing
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "Save SaveXlRangeToWordFile error"
Application.CutCopyMode = False
Set ObjPic = Nothing
PFWdApp.Quit
Set PFWdApp = Nothing
End Sub

HTH. Dave

 

[frank_AL]

Hi frank_AL. You don't seem to be copying anything to paste? Your use of .Application is wrong. It should be...

With iApp.iDoc
.Selection.Find.Text = "The following pricing changes "
'etc.

Search my posts for pasting pictures to Word using PasteSpecial. The code should look something like this...

Sub SaveXlRangeToWordFile()
Dim ObjPic As Object, PFWdApp As Object
On Error GoTo ErFix
Set PFWdApp = CreateObject("Word.Application")
PFWdApp.Documents.Open Filename:="C:\foldername\summary.doc", ReadOnly:=False
PFWdApp.ActiveDocument.Content.PasteSpecial DataType:=3 '9  '4
'pictures in newxl version are converted to inlineshapes
'takes time to paste and convert
Dim t As Double
t = Timer
Do Until Timer - t > 1
  DoEvents
Loop

For Each ObjPic In PFWdApp.ActiveDocument.InlineShapes
ObjPic.ConvertToShape
Next ObjPic

PFWdApp.ActiveDocument.Close savechanges:=True
PFWdApp.Quit
Application.CutCopyMode = False
Set ObjPic = Nothing
Set PFWdApp = Nothing
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "Save SaveXlRangeToWordFile error"
Application.CutCopyMode = False
Set ObjPic = Nothing
PFWdApp.Quit
Set PFWdApp = Nothing
End Sub

HTH. Dave

Dave,

Thank you for your response. It will be tomorrow before I get a chance to implement your recommendations. I was testing this code & manually copying from Excel while I was testing.

Thanks again. I’ll let you know how it turns out.

 

[frank_AL]

Dave,
When I tried what you suggested,

 With iApp.iDoc

I received the following Compile error message "Method or data member not found". After doing some additional searching online I inserted the line of code:

.Application.Selection.TypeParagraph

just prior to the line

.Application.Selection.Paste

and that solved my issue of the code stopping after the Paste command was executed.

Just FYI, the sample data I was using to develop the code has 5 iterations where Rows are Hidden in Excel, a chart created and the desired data was copied to the chart as a picture. Then a Word document is opened, the picture is pasted, the Word document is saved as a PDF file and then emailed. All 5 iterations are completed in less than 2 minutes and a good bit of that time is because I have a 10 second pause to ensure I don't overwhelm Outlook.

 

[NdNoviceHlp]

Thanks for posting your outcome. Word is a funny thing. I guess it needed some direction as to where to paste the picture? My suggestion probably should have been...

With iapp.Selection

U could then remove the Application.Selection parts but the code SaveAs2 location would then have to change. Anyways, if out of the blue, your routine mysteriously crashes for no apparent reason, be aware the clipboard may (and likely will) crash. U may need to add some code to clear the clipboard if U intend to repetitively use the routine. Glad that you got it sorted out. Dave

 

[frank_AL]

Thanks for posting your outcome. Word is a funny thing. I guess it needed some direction as to where to paste the picture? My suggestion probably should have been...

With iapp.Selection

U could then remove the Application.Selection parts but the code SaveAs2 location would then have to change. Anyways, if out of the blue, your routine mysteriously crashes for no apparent reason, be aware the clipboard may (and likely will) crash. U may need to add some code to clear the clipboard if U intend to repetitively use the routine. Glad that you got it sorted out. Dave

I understand your follow up recommendation...........
Thank you for the suggestion about clearing the clipboard. I will certainly at that to the routine.