事の発端
ExcelからWordにグラフをコピーしたかった。(1回だけではなく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上のどこにもこのような解決方法は書かれていないので、このエラーで悩んだ人は、たくさんいただろうなと思います。