Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


54 / 13006 ツリー ←次へ | 前へ→

【78927】ExcelグラフをWordに貼り付けるマクロについて kiho 17/3/4(土) 23:33 質問[未読]
【78928】Re:ExcelグラフをWordに貼り付けるマクロに... γ 17/3/5(日) 6:58 発言[未読]
【78929】Re:ExcelグラフをWordに貼り付けるマクロに... kiho 17/3/5(日) 10:02 お礼[未読]
【78930】Re:ExcelグラフをWordに貼り付けるマクロに... γ 17/3/5(日) 13:19 発言[未読]

【78927】ExcelグラフをWordに貼り付けるマクロに...
質問  kiho  - 17/3/4(土) 23:33 -

引用なし
パスワード
   初めて投稿させていただきます。よろしくお願いいたします。

ネットの情報を見ながら、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

---ここまで

 原因を調べる為のヒントでも結構ですので、何卒、よろしくお願いいたします。

【78928】Re:ExcelグラフをWordに貼り付けるマクロ...
発言  γ  - 17/3/5(日) 6:58 -

引用なし
パスワード
   Word側の処理が追いつかないということなんでしょうか。
ループのなかで適当な遊びを設けてみてはどうですか?
・DoEventsを入れる。(複数回繰り返してもよい)
・ExcelのApplication.Wait メソッド
・APIのSleep
などいくつか手はあるでしょう。

【78929】Re:ExcelグラフをWordに貼り付けるマクロ...
お礼  kiho  - 17/3/5(日) 10:02 -

引用なし
パスワード
   γさん
早速のアドバイス、ありがとうございます。

“Word側の処理が追いつかない”という、自分では
ちょっと思い付かないことでした。

 ご提示のあった、
>・DoEventsを入れる。(複数回繰り返してもよい)
>・ExcelのApplication.Wait メソッド
>・APIのSleep
 を試してみましたが、今回は、これが原因では
なかったようです。

 更にあれこれ自分で考えて対処してみたなかで、
貼り付けるグラフ図のサイズを小さくしてみたところ、
正常に処理できました。(うれしかった〜)

 グラフ図のサイズがWord文書の貼り付け位置の
横幅より少々大きかったようで、数枚の貼り付け
処理ができていたので、グラフ図自体には問題ない
と思っていたのがいけなかったと思います。

 発想の転換が必要ですね。これも、今回、γさん
からのアドバイスの影響だと思いました。

 本当に、どうもありがとうございました。

【78930】Re:ExcelグラフをWordに貼り付けるマクロ...
発言  γ  - 17/3/5(日) 13:19 -

引用なし
パスワード
   解決したようで何よりです。

ただし、単純にグラフの大きさが原因とも思えません。
拡張メタファイルであれば、大きさは調整されて貼り付けられるはずです。
横幅が長いもので実験してもエラーにはなりません。
なにか別の原因、もしくは複合した要因で発生している気がします。

閲覧者が誤解してはいけないと思いコメントしたまでで、
原因追及を求めるものではありません。
ではこの辺で。

54 / 13006 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free