Excel VBA inconsistent errors when trying to copy and paste objects from Excel to Word

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154
Hello All,

I have some VBA code that will sometimes run just fine and sometimes will give an error. I am getting very frustrated and in need of some help ... I have tried various things, but just cannot find a solution.

First ... what I am trying to do ...

I have an embedded Word document with various bookmarks. These bookmarks corespondent to named ranges in the Excel workbook. My VBA code:
  • Opens the embedded Word document
  • Makes a copy of the document and then closes the embedded document to preserve its contents
  • Within a loop in the VBA code, copies the various named ranges in the Excel workbook and pastes the content of the clipboard at the appropriate bookmark in the Word document. Also, depending on what I am trying to do it will paste as picture or table.

Here is the VBA code ...

Code:
Sub create_diy_report_latebinding()


Dim wdApp As Object
Dim wdDoc As Object
Dim newWord As Object
Dim oleObj As Object
Dim pasteobject As Range
Dim diy_excel_range As String
Dim diy_word_bm As String
Dim diy_excel_content As String
Dim diy_word_content As String
Dim diy_vba_case As Integer
Dim diy_sheet_num As Worksheet
Dim ws As Worksheet
Dim detailnum As String
Dim shownum As String
Dim i As Integer
Dim bmrange As String
Dim mytable As Object
Dim headertext As String
Dim errorcount As Integer




Application.ScreenUpdating = False


On Error GoTo errorhandler
errorcount = 0 ' Set errorcount to zero


Application.DisplayAlerts = False


Set oleObj = Sheet5.OLEObjects("diy_template")
oleObj.Verb Verb:=xlPrimary
oleObj.Activate


Application.DisplayAlerts = True


Set wdApp = oleObj.Object.Application


With wdApp
    .Visible = True
    .Activate
    Set wdDoc = wdApp.Documents(1) ' wdDoc will be the embedded Word doc
    .Documents.Add ' add a new document
    Set newWord = wdApp.Documents(1) ' newWord will be the new blank document
End With


'Select and copy all content from DIY Template to the new Word document
    wdDoc.Content.Copy ' copy contents from the diy template
    newWord.Content.Paste ' paste contents into the new document


' Close the DIY Template to prevent changing it and then activate the new Word doc
    wdDoc.Close (wdDoNotSaveChanges)
    newWord.Activate
'
' Perform edits on the new Word document by copying and pasting content from RFA
With newWord
    For Each c In Sheet5.Range("diy_report_bmnum") 'All values from table in Data Validation sheet
        diy_excel_range = c.Offset(0, 1).Value
        diy_word_bm = c.Offset(0, 2).Value
        diy_excel_content = c.Offset(0, 4).Value
        diy_word_content = c.Offset(0, 5).Value
        diy_vba_case = c.Offset(0, 6).Value


        Select Case diy_vba_case


            Case 1 'Copy range and paste as text replace bookmark text with text from Excel range
'                .Bookmarks(diy_word_bm).Range.InsertAfter (Range(diy_excel_range).Value) 'Copies single cell value after word bookmark
                .Bookmarks(diy_word_bm).Range.Text = Range(diy_excel_range).Value 'Copies single cell value to replace word bookmark text


            Case 2 'Copy range or table as picture and paste as picture
                Range(diy_excel_range).CopyPicture
                .Bookmarks(diy_word_bm).Range.Characters.Last.Paste


            Case 3 'Copy chart from Sheet10 and paste as picture
                Sheet10.ChartObjects(diy_excel_range).Activate
                Sheet10.ChartObjects(diy_excel_range).Copy 'Copies chart from Excel and pastes as picture in Word
                .Bookmarks(diy_word_bm).Range.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False


            Case 4 'Copy chart from Sheet7 and paste as picture
                Sheet7.ChartObjects(diy_excel_range).Activate
                Sheet7.ChartObjects(diy_excel_range).Copy 'Copies chart from Excel and pastes as picture in Word
                .Bookmarks(diy_word_bm).Range.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False


            Case 5 'Copy chart from Sheet4 and paste as picture
                Sheet4.ChartObjects(diy_excel_range).Activate
                Sheet4.ChartObjects(diy_excel_range).Copy 'Copies chart from Excel and pastes as picture in Word
                .Bookmarks(diy_word_bm).Range.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False


            Case 6 'Copy range or table and paste as table
                Range(diy_excel_range).Copy ' copy range of cells as table from Excel
                .Bookmarks(diy_word_bm).Range.Characters.Last.Paste ' paste to Word
                .Tables(.Tables.Count).Rows.AllowBreakAcrossPages = False
                .Tables(.Tables.Count).Shading.BackgroundPatternColor = wdColorAutomatic
                .Tables(.Tables.Count).Borders.InsideLineStyle = wdLineStyleNone
                .Tables(.Tables.Count).Borders.OutsideLineStyle = wdLineStyleNone


            Case Else
        End Select
        
            ' insert delay to ensure that all actions complete before going to next case
            '    Application.Wait (Now() + TimeValue("0:00:1"))
        
        
        
    Next c




    ' copy all component details as picture and paste into word


        For i = 250 To 1 Step -1 ' For each component item from 1 to 250, do in reverse order


            Application.CutCopyMode = False 'clear clipboard
            detailnum = "detail" & i
            shownum = "show" & i


            ' Check if the item is included in the component list, if not skip
            If Range(shownum).Value = 1 Then
                Range(detailnum).CopyPicture ' copy range as picture from Excel
                .Bookmarks("comp_details_bookmark").Range.Characters.Last.Paste
                Application.CutCopyMode = False 'clear clipboard
            Else
            End If


        Next i


End With 'End with newWord doc


' Update all fields in the document
    newWord.TablesOfContents(1).Update
    newWord.TablesOfFigures(1).Update
    newWord.TablesOfFigures(2).Update
    newWord.Fields.Update




' Format tables except the "Terms and Def" table
    For Each mytable In newWord.Tables
        If mytable.Title <> "terms" Then
            mytable.Range.Font.Size = 9
            mytable.Rows(1).HeadingFormat = True 'Set first row as table header
            mytable.Rows(2).HeadingFormat = True 'Set second row as table header
            mytable.Rows.AllowBreakAcrossPages = False ' prevent rows breaking across pages
        Else
            mytable.Shading.ForegroundPatternColor = -16777216 ' Set "terms" table for automatic color prevent different shading
            mytable.Shading.BackgroundPatternColor = -16777216 ' Set "terms" table for automatic color prevent different shading
        End If
    Next




On Error GoTo dispmsg


newWord.sections(2).headers(1).Range.Text = Sheet5.Range("diy_header").Value
newWord.sections(2).headers(1).Range.Paragraphs.Alignment = 2 ' Right justify header




Set wdApp = Nothing
Set wdDoc = Nothing


Sheet16.Select


dispmsg:


Select Case errorcount
    Case Is = 0
        MsgBox "Reserve Study Report Complete", vbInformation + vbOKOnly, "Reserve Study Report"


    Case Is > 0 'display message about an error was found
        MsgBox "Reserve Study Report Created.  A total of " & errorcount & " error(s) encountered during report creation.  " & vbNewLine & vbNewLine & _
        "The errors or likely minor.  Try closing the Word document without saving.  Then run this routine again." & vbNewLine & vbNewLine & _
        "If error(s) persist, review the report for potential omissions of data such as tables and charts.  " & _
        "You may have to perform manual edits and changes.", vbCritical + vbOKOnly, "Reserve Study Report Errors"
    End Select


Exit Sub


errorhandler:


MsgBox (diy_word_bm)


    errorcount = errorcount + 1
    Resume Next


End Sub

If you examine the code, you will see starting with the statement, "With newWord", that I am reading a table in the Excel workbook to obtain the named range and the bookmark. Here is that table ...

BookmarkExcel RangeWord BookmarkDescriptionExcel ContentWord ContentVBA CaseExcel Sheet Num
1hoanamehoanameHOA Namerangetext1Sheet19
2hoa_city_statehoa_city_stateHOA City and Staterangetext1Sheet19
3currentyearcurrentyearCurrent Year of Analysisrangetext1Sheet19
4todays_datereport_dateToday's Daterangetext1Sheet5
5cummunity_profilecummunity_profileCommunity Profile & Account Summarytablepicture2Sheet10
6current_pctfunding_barchartcurrent_pctfunding_barchartCurrent Pct Funding Horizontal Chartchartpicture3Sheet10
7reserve_study_parametersreserve_study_parametersReserve Study Parameterstablepicture2Sheet10
8current_income_sourcescurrent_income_sources tablepicture2Sheet10
9current_expensescurrent_expenses tablepicture2Sheet10
10future_income_sourcesfuture_income_sources tablepicture2Sheet10
11res_comp_summary_tableres_comp_summary_tableReserve Component Inventory Tablestabletable6Sheet3
12allocation_bycategory_smallchartallocation_bycategory_chartColumn chart of Reserve Fund by Categorychartpicture5Sheet4
13income_and_expense_summaryincome_and_expense_summaryIncome and Expense Summaryrangepicture2Sheet18
14annual_res_expenditures_chartannual_res_expenditures_chart chartpicture4Sheet7
15all_annual_expenses_chartall_annual_expenses_chart chartpicture4Sheet7
16pctfund_chartpctfund_chart chartpicture4Sheet7
17annual_res_contrib_chartannual_res_contrib_chart chartpicture4Sheet7
18startyear_reserve_expenses_chartstartyear_reserve_expenses_chart chartpicture4Sheet7
19reserve_balance_compare_chartreserve_balance_compare_chart chartpicture4Sheet7
20pct_funded_compare_chartpct_funded_compare_chart chartpicture4Sheet7
21spec_assess_risk_chartspec_assess_risk_chart chartpicture4Sheet7
22contingency_fund_summarycontingency_fund_summary tablepicture2Sheet10
23eoy_contingency_charteoy_contingency_chart chartpicture4Sheet7
24diyheading_yrs1diyheading_yrs1Heading text for DIY reportrangetext1Sheet5
25income_expense_summary1income_expense_summary1income expense summ yr 1-10rangepicture2Sheet13
26sheet13table2sheet13table2Reserve expenses yrs 1-10tabletable6Sheet13
27diyheading_yrs2diyheading_yrs2Heading text for DIY reportrangetext1Sheet5
28income_expense_summary2income_expense_summary2income expense summ yr 11-20rangepicture2Sheet13
29sheet13table6sheet13table6Reserve expenses yrs 11-20tabletable6Sheet13
30diyheading_yrs3diyheading_yrs3Heading text for DIY reportrangetext1Sheet5
31income_expense_summary3income_expense_summary3income expense summ yr 21-30rangepicture2Sheet13
32sheet13table10sheet13table10Reserve expenses yrs 21-30tabletable6Sheet13
33detail1 to detail 250comp_details_bookmarkIndividual detail tablesrangepicture0Sheet6

<colgroup><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

Here is the issue I am having.

Sometimes when I execute the VBA, it gives me an error. It fails at inconsistent places. For example it might fail when attempting to copy/paste the named range, "income_expense_summary1". Or maybe at a different range/bookmark.

Other times, it will run without error and everything is as I wished it be.

I would so like it if someone can see what I am doing wrong ... cuz I am banging my head into wall trying to figure this out.

Thanks

Steve B.
 

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154
Hi Jon,

That is good to know. I will go back and try to use Timer with less than one second.

The other news is that by placing the Sleep function in a couple of strategic spots in the VBA code, my subroutine is starting to behave. I am getting much better consistency running through the VBA and copying and pasting various ranges and charts from Excel to Word. The world is starting to spin correctly again. Keeping my fingers crossed as I continue to test.

Thanks for your help.

Regards,

Steve
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,966
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I'll be interested in your findings. Because of reasons that are lost in the depths of time, I have avoided using Sleep and Wait functions for this purpose, and rely on Timer only. But the problems are becoming more pronounced in each successive version of Excel. 2010 was great, 2013 had some issues, 2016 had more, and not Office 365 is fraught with timing issues.
 

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154
Hello,

Recap ... I am opening an embedded Word document in my Excel workbook. I copy the Word doc as a new doc and then closed the embedded document to preserve it for next time. With the new Word doc, I am copying various defined ranges and charts in the Excel workbook and pasting these objects into the new Word doc at predefined bookmarks. In some cases I copy ranges and pictures and paste as pictures. In same cases ranges are pasted as Word tables. The charts are all copied as pictures and pasted same. The resulting Word doc contains over 8000 words and is 45 to 80 pages long.

My environment:
  • Intel i7-9700 CPU @ 3 GHz
  • 32GB memory
  • Windows 10 OS
  • MS Office 2019

Some initial results in my testing ... this is not a fully extensive test procedure, but these results are encouraging.


  • I inserted a short delay time in VBA execution in the following points in my VBA
    • 2 s delay after declaration of variables and before first opening the embedded Word document
    • With first batch of copy/paste ops (ranges and charts), 1 s delay after each paste to delay VBA before moving to next copy operation
    • 1 s delay after this initial run of copy and paste before moving onto the next batch of ranges
    • With second batch of copy/paste ops (all ranges which are pasted as pictures), 5 ms delay after each paste before doing next copy (250 total ranges here that are copied and pasted)
  • I removed all instances of DoEvents. Seems this does not help and may actually cause problems.
  • Using the Windows Sleep function (see my earlier post) seems to be more stable than using the VBA Timer routine. I have tried both with the same delay time and Sleep seems to be better.

As I said, my initial testing is encouraging, but need to do further testing on multiple machines.

Steve
 

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154
Another update ...

I still continue to get these inconsistent errors. And they really are inconsistent. Sometimes running the macro and get no errors. Sometimes get error but often at different points in the routine. I will admit that with these sleep statements in the code, they are less than without. Still working on this.

Steve
 

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154

ADVERTISEMENT

I thought I would post an update on this problem that I am having.

First, to restate what the issue is ...
  • I have an embedded MS Word document with bookmarks
  • I open the embedded document, copy it, then close the original. Then working with the copy, I want to insert various objects into the Word document. I use copy and paste to copy the object from Excel to the appropriate bookmark location in the Word document.
  • Some of the objects are charts of which I copy and paste the chart as a picture. Some are ranges / tables and depending on my objective I may copy the range or table as a picture for pasting or I may copy the range or table as values or text and paste into word as a table (or text).
I am using late binding for this macro. As this application is designed so other users can use it, I did not want force the other users to have to manually add the reference library.

The VBA that I created is working pretty well. I have some error trapping in it so I can identify which object the copy/paste function has a problem with. So troubleshooting is pretty easy.

By inserting short intervals of time between the copy and paste functions, I have been able to consistently eliminate errors. Which others more knowledgeable than I state is likely a crash of the clipboard which is caused by synchronization issues between the computer's CPU with respect to the contents of the clipboard. Perhaps trying to paste from the clipboard but the clipboard is empty. I have tried using DoEvents with no difference. Application.Wait does nothing. I have created functions and that does not resolve anything. Only time intervals helps.

There is an issue I would like to resolve. The Excel application might run fine on my desktop PC, but when I try to run it on my laptop I get the errors. In order to resolve the issue on the laptop, I have to add additional time between the copy and paste functions. Adding this extra time, resolves the problem. I have found the time interval for success on the desktop is around 10 ms. On the laptop, this more like 300 ms. I would love to get a solution that resolves without adding time intervals.

Steve
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,966
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I don't have sample code, just the pseudocode below, but I've seen a suggestion to put the paste into a do loop which just keeps trying the paste, and exits the loop if there's no error:

VBA Code:
' NOT REAL CODE
MyChart.Copy
Do
    On Error Resume Next
    Something.Paste
    If Err.Number = 0 Then Exit Do
    DoEvents
Loop
On Error GoTo 0
 

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154

ADVERTISEMENT

I don't have sample code, just the pseudocode below, but I've seen a suggestion to put the paste into a do loop which just keeps trying the paste, and exits the loop if there's no error:

VBA Code:
' NOT REAL CODE
MyChart.Copy
Do
    On Error Resume Next
    Something.Paste
    If Err.Number = 0 Then Exit Do
    DoEvents
Loop
On Error GoTo 0

Thanks for the suggestion, Jon,

Going to give this a try.

Steve
 

bisel

Board Regular
Joined
Jan 4, 2010
Messages
154
Thanks for Jon Peltier, I may have the solution. Jon suggested putting in a Do Loop to retry the copy/paste operation. That seems to have done the trick.

Here is the code that I used ...

VBA Code:
      On Error GoTo 0  ' Normal error handling
      Application.CutCopyMode = False   ' Clear clipboard before copy
      Range(excel_range_name).CopyPicture
      n = 1 ' Set counter to 1
      Do Until n > 3 'Attempt paste function three times before falling out
            If n < 3 Then  ' suspend normal error handling
                On Error Resume Next
            Else
                 On Error GoTo 0 ' on last attempt, reinstate normal error handling
            End If
            newWord.Bookmarks(bookmark_name).Range.Characters.Last.Paste   ' Paste into Word
            If Err.Number = 0 Then
                  On Error GoTo 0 'reinstate normal error handling
                  Exit Do   ' Exit if no error encountered
            End If
            n = n + 1  ' Increment counter and repeat the Do Until Loop
            DoEvents
      Loop
       On Error GoTo 0  ' Just to make sure that normal error handling is reinstated

So far so good. Things to seem to be working as intended and I am very grateful to Jon Peltier. Thank you sir!

Steve
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,966
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Thanks for Jon Peltier, I may have the solution. Jon suggested putting in a Do Loop to retry the copy/paste operation. That seems to have done the trick.

Here is the code that I used ...

VBA Code:
      On Error GoTo 0  ' Normal error handling
      Application.CutCopyMode = False   ' Clear clipboard before copy
      Range(excel_range_name).CopyPicture
      n = 1 ' Set counter to 1
      Do Until n > 3 'Attempt paste function three times before falling out
            If n < 3 Then  ' suspend normal error handling
                On Error Resume Next
            Else
                 On Error GoTo 0 ' on last attempt, reinstate normal error handling
            End If
            newWord.Bookmarks(bookmark_name).Range.Characters.Last.Paste   ' Paste into Word
            If Err.Number = 0 Then
                  On Error GoTo 0 'reinstate normal error handling
                  Exit Do   ' Exit if no error encountered
            End If
            n = n + 1  ' Increment counter and repeat the Do Until Loop
            DoEvents
      Loop
       On Error GoTo 0  ' Just to make sure that normal error handling is reinstated

So far so good. Things to seem to be working as intended and I am very grateful to Jon Peltier. Thank you sir!

Steve
Thanks for the follow up. I haven't used this approach, but I think it has merit, and you've helped to convince me.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,119
Messages
5,640,219
Members
417,131
Latest member
Seanr19871

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top