Excelの表とグラフをWordに転送する

　実行時バインディングと事前バインディングの解説が済んだところで、実用的なExcelとWordの連携例を紹介しましょう。
　表計算ソフトとワープロソフトの連携ということであれば、やはりExcelの表やグラフをWordの定型文書に貼り付けて印刷するのが一般的な活用例ではないでしょうか。
　この連携の流れは、図3のようなWordの定型文書と図4のようなExcelのワークシートがあり、そしてリスト2のマクロを実行すると、図5のようにExcelの表とグラフがWordの定型文書に貼り付けられて印刷される、というものです。

図3：Wordの定型文書

図4：Wordに転送するExcelの表とグラフ

図5：Wordの定型文書に貼り付けられたExcelの表とグラフ

　実際に自分の手でリスト2のマクロをコーディングして、その結果を確認してみてください。ただし、リスト2ではExcelのブックとWord文書は同一フォルダにあるものと仮定してプログラミングされていますので注意してください。なお、リスト2の詳細については、リスト内のコメントを参照してください。

リスト2：Excelの表とグラフをWordに転送する

 Sub MakeWordApp2()
     ' アクティブなExcelブックが保存されているフォルダを
     ' カレントフォルダにする
     ChDrive ActiveWorkbook.Path
     ChDir ActiveWorkbook.Path
 
     ' Wordオブジェクトのインスタンスを作成
     Set objWord = CreateObject("Word.Application")
 
     With objWord
         ' Wordを表示
         .Visible = True                      		        　
　 　　　　' ウィンドウを最大表示
         .WindowState = wdWindowStateMaximize 		        
　　 　　　' Reprot.docを開く
         .Documents.Open "Report.doc"         		
         'Reprot.docをオブジェクト変数に代入
         Set objWordDoc = .ActiveDocument
         '文書にテキストを挿入
         With .Selection
             .Move Count:=objWordDoc.Characters.Count
             .InsertParagraphAfter
             .InsertAfter "書籍販売部数"
             .InsertParagraphAfter
             .MoveRight
         End With
     End With
 
     ' セルのデータをコピー
     Worksheets("販売部数").Range("販売部数").Copy
 
     ' Wordに貼り付け
     With objWord.Selection
         .Paste
         .TypeParagraph
     End With
 
     ' グラフをコピー
     Worksheets("販売部数").ChartObjects(1).Copy
 
     ' Wordに貼り付けて書式設定
     With objWord
         .Selection.PasteSpecial Placement:=wdInLine, _
          DataType:=wdPasteMetafilePicture
         .Selection.ParagraphFormat.Alignment = _
          wdAlignParagraphCenter
     End With
 
     ' 印刷（印刷中はマクロの実行は中断する）
     objWord.PrintOut Background:=False
 
     ' 文書を保存せずに閉じる
     objWordDoc.Close SaveChanges:=False
     ' Wordを終了する
     objWord.Quit                			    
　　 ' オブジェクト変数をクリアする
     Set objWord = Nothing
     Set objWordDoc = Nothing
 End Sub