| |
初めて投稿させていただきます。よろしくお願いいたします。
ネットの情報を見ながら、Excelのシート上の複数のグラフを
Word文書に貼り付けるVBAを作成していますが、エラーとなって
しまい、困っています。自分なりに調べ、あれこれやってみたの
ですが、うまく行きません。アドバイスをいただけないでしょうか。
処理内容は下記のリストの通りなのですが、概要は以下の通りです。
1)Word.Application の参照を設定
2)新しいWord文書を追加・表示
3)対象とするExcelファイルの数(fCount)と名称(fName(i))を取得
（他のサブルーチン GetFilesName で行っていて、上記2つの
変数はグローバルなものとしています。）
4)ファイル数 fCount（現在は1つ）のループの中で、そのファイル
を絶対パス（stdDir & fName(i))でオープン
5)シート数(sCount)を取得（現在7つ）して、その数分、以下を実施
6)シート名を取得して、そのシート上のグラフ数(nfig)を取得、
そのグラフ数分、以下を実施
7)各グラフを選択し、クリップボードにコピーした後、Word文書に
ペースト
8)上記をループ処理した後に、後処理して終了
上記の処理で、シート1枚目(j=1の時)にはグラフは無い為、何も処理
しません。シート2枚目（j=2のとき）には、グラフが14枚(nfig=14)
あるのですが、その内、5枚だけ描いて、6枚目で以下のエラーと
なってしまうのです。
---
実行時エラー'4198:
コマンドは正常終了できませんでした。
---
エラーは、Word文書へペーストする“.Selection.PasteSpecial…”
の所でですが、グラフを5枚描く処理も、6枚目を描く処理も変わらない
のに、何故エラーとなるのか、わからない状況です。
---
＜リスト＞
Sub WrdCreate_main()
Dim nWord As Object
Dim nWordDoc As Object
Dim nfig As Long
Set nWord = CreateObject("Word.Application") '「Word.Application」オブジェクトへの参照
With nWord
Set nWordDoc = .Documents.Add '新しいWord文書を追加、表示
.Visible = True
End With
Call GetFilesName '対象Excelファイルのファイル数：fCount と
'その各ファイル名：fName(i) を取得してくる
For i = 1 To fCount
Set wb = Workbooks.Open(strDir & fName(i)) '対象Excelファイルを順次オープン
sCount = wb.Sheets.Count 'シート数の取得
ReDim sName(1 To sCount)
For j = 1 To sCount
sName(j) = wb.Sheets(j).Name 'シート名の取得
nfig = wb.Sheets(j).ChartObjects.Count 'シート毎のグラフ数の取得
For k = 1 To nfig
Sheets(sName(j)).ChartObjects(k).Select
Worksheets(sName(j)).ChartObjects(k).Copy 'シート上のグラフ1枚をクリップボードへ
With nWord 'クリップボード上の内容をWord文書へ
.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteMetafilePicture
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With
Next k
Next j
Next i
Set nWord = Nothing
Set nWordDoc = Nothing
End Sub
---ここまで
原因を調べる為のヒントでも結構ですので、何卒、よろしくお願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
