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

bisel

Board Regular
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.
 

NdNoviceHlp

Well-known Member
Hi Steve B. Inconsistent and unexplained errors when using copy/paste usually means that your clipboard is crashing. U need to add some API code at the top of a module....
Rich (BB code):
#If VBA7 Then
    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
#Else 
    Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function CloseClipboard Lib "user32" () As Long
    Public Declare Function EmptyClipboard Lib "user32" () As Long
#End  If
To operate...
Rich (BB code):
Application.CutCopyMode = False
 OpenClipboard (0&)
 EmptyClipboard
 CloseClipboard
HTH. Dave
 

bisel

Board Regular
Hi Dave,

I tried your suggestion, but it did not make any difference. But, I did find something that seems to work.

I found reference that others were experiencing similar problems and as they stated, it almost seems that the VBA is executing faster than the copy from Excel and paste to Word can keep up. Sometimes getting to a point where in trying to paste something, there isn't anything in the clipboard to paste.

The solution was to insert a "DoEvents" after the copy and before the paste and a DoEvent after the paste before moving on to the next copy operation. So far, that seems to be working.

Steve
 

bisel

Board Regular
I spoke too soon. Still getting intermittent errors when I run the VBA. Tried all your suggestions. Tried inserting DoEvents before and after the copy and the paste functions. Errors are unpredictable and they do not always occur with the same object or range that I am trying to copy and then paste. But, they always do occur with the paste function. When the error occurs, the error code is 1004 associated with the paste function.

Steve
 

Jon Peltier

MrExcel MVP
In my experience, DoEvents takes care of most of this problem. Application.Wait doesn't help, because it prevents anything from actually catching up.

Better than Wait might be:

Code:
Dim t As Double
t = Timer
Do Until Timer - t > 1
  DoEvents
Loop
I've found that if I encapsulate the copy and paste operations into functions, and the main code calls the functions to perform these operations. entering and leaving a function seems to make VBA wait until operations within that function have completed.

For example, this simplified function pastes a chart into Word. The object passed into the function, oWdRng is the Word range where the chart will be pasted, which could be a bookmark but in this case is a regular range 0 characters wide; the object returned by the function is also a Word range 0 characters wide, positioned at the end of the chart, which pasted inline is one character wide.

Code:
Function PasteChartInWord(oWdRng As Object) As Object

  DoEvents
  oWdRng.PasteSpecial DataType:=WordPasteFormat(wdChtFormat), Placement:=0  ' 0 = wdInLine

  oWdRng.Collapse 0  ' 0 = wdCollapseEnd
  Set PasteChartInWord = oWdRng

End Function
This procedure is called like this:

Code:
  MyChart.ChartArea.Copy
  DoEvents
  Set oWdRng2 = PasteChartInWord(oWdRng)
Also note that I don't activate the chart before copying it.
 

NdNoviceHlp

Well-known Member
Thanks Jon for sharing your experience. I hope that bisel gained as much learning as I did. Your information about using a timer instead of wait actually resolved my ongoing issues with phantom listbox selections posted here...
https://www.mrexcel.com/forum/excel-questions/466168-phantom-listbox-selection.html?highlight=listbox
Replacing wait with the timer routine completely resolved the issues I was having (that seemed resolved but were continuing to episodically occur). Thanks for that. Your insight into separating the copy and paste routines is also something that I have accidently stumbled into implementing apparently because it works. Now I have an understanding of why. Again thanks for your insights. Dave
 

bisel

Board Regular
An update on the issue I am having ...

I tried all the suggestions. I created a function and that did not resolve the issue. Instead of a function, a tried it as subroutine that I call from the main sub. Still have the problem. I inserted DoEvents in the code, but that did not make a difference. I put in the timer routine which pauses execution for 1 second. That seems at first blush to help, but I still get those inconsistent errors when copying a range or chart from Excel and paste it into Word. And the errors are indeed inconsistent ... that is, the error(s) are not always the same range or chart and in many instances, if I close the Word document without saving and run the VBA sub again, in many cases it runs to completion without errors.

Just banging my head on the wall trying to find a way to get around this. I am assuming that the error can be one of several things, but it appears that timing is the key issue. I am going to try to insert some additional timer routines into a few steps in the VBA and see if this helps.

Steve
 
Last edited:

bisel

Board Regular
I have stumbled across this method for pausing execution for less than one second ... trying this out inside the VBA code to see if can find a balance to timing issues without extending execution of the VBA too long.

Using the VBA code making use of Timer ... e.g., if you code this ...

Code:
t = Timer
Do Until Timer - t > 1
Loop
You set a timer to pause the VBA for one second. Problem is if you want to pause for less than one second or a fractional part of second. The Timer routine can only resolve for increments of one second.

However, using the Windows API function, Sleep, one can be more granular and specify a time period in milliseconds. Sleep is not part of VBA, but can be accessed by using a special declaration statement in the VBA code. I placed the following lines of code as a public declaration statement at the beginning of the VBA module ...

Code:
[COLOR=#333333][FONT=Consolas][SIZE=3][FONT=arial][SIZE=2]#If VBA7 Then ' Excel 2010 or later
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]  ' Excel 2007 or earlier
    Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If[/SIZE]
[/FONT][/SIZE]
[/FONT][/COLOR]
With the public declaration statement (above), I then use the Windows Sleep API ...
"Sleep n" ... where n is a number in milliseconds.

So, to pause for 1 second, the syntax is Sleep 1000

This API does lock out the user until the sleep period has finished, but in my case, that is what I want to do. Using Ctrl+Break will interrupt the macro. BTW, the Sleep API is Windows only, not on a Mac.

Steve
 
Last edited:

Jon Peltier

MrExcel MVP
Code:
Sub TestTime()
  Dim t As Double
  t = Timer
  Do Until Timer - t >= 0.5
    DoEvents
  Loop
  Debug.Print Timer - t
End Sub
The output in the Immediate Window is:

0.5

So you can in fact wait less than one second using Timer, without locking up everything the way Wait does. It's not terribly precise; if I change the Do command to

Code:
  Do Until Timer - t >= 0.1
The Immediate Window displays:

0.1015625
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top