事の発端

ExcelからWordにグラフをコピーしたかった。(１回だけではなく50回くらい色んなグラフをコピー処理をする)
PasteSpecialでコピーは出来るが、数回に一回はエラーがでることが分かった。
さて、どうしよう・・・。

環境

Windows 10
Excel 2019
Word 2019

自己評価

ExcelからWordにグラフを貼り付けるマクロを使う場合は、このページのサンプルコード参考にした方が絶対にいいです。

PasteSpecial で出るエラーについて

PasteSpecialとは、クリップボードにコピーされた情報をペーストする関数です。
webで検索すると、DoEventを使えば、エラーが回避されるという情報もあります。

DoEvents
Sleep 75
DoEvents

上のようにすれば解決するとWebでは出てきますが、自分は解決しませんでした。

自分が考えた解決方法

・Excelに「Sheet1」という名前のWorksheetを作り、その中に「1」という名前のグラフを作っているものとした上で、以下のマクロを動作させます。

Sub main()
    Dim wsh As Worksheet
    Set wsh = ThisWorkbook.Worksheets("Sheet1")
    
    '参照設定で、Microsoft Word 16.0 Object Libraryにチェックを入れる
    Dim wdApp As Word.Application
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    wdApp.Activate
    
    Dim wdDoc As Word.Document
    Set wdDoc = wdApp.Documents.Add
    wdApp.Selection.TypeParagraph

    Dim count As Long
    count = 0
    
    Dim i As Long
    For i = 0 To 100
        Call myCopy(wdApp, wsh.ChartObjects("1"))
    Next
    MsgBox "正常に処理を完了しました。"
End Sub

Sub myCopy(wdApp As Word.Application, obj As Variant)
    Dim msg As String
    Dim count As Long
    count = 0
    On Error GoTo myError
    obj.Copy
    wdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteMetafilePicture
    wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Exit Sub
myError:
    count = count + 1
    Sleep 100
    DoEvents
    If count = 10 Then
        msg = "回数:" & count & vbCrLf
        msg = "エラー番号：" & Err.Number & vbCrLf
        msg = msg & "エラーの種類:" & Err.Description
        MsgBox msg, vbExclamation
        End
    End If
    Resume
End Sub

・これで何度実行してもエラーは出ません。自分以外の環境でもエラーは出ないと思います。
・PasteSpecialでエラーが出ても、出来るまで繰り返せばいいんじゃないか？という強引な発想でしたが、これが正しい解決方法だと思います。Resume Nextで回避するのではなく、Resumeで繰り返しトライしています。
・myCopyの中の処理が重要です。参考にしてください。
・Web上のどこにもこのような解決方法は書かれていないので、このエラーで悩んだ人は、たくさんいただろうなと思います。