ruby-robotの夢

cygwin-ruby,qgisの達人を目指す奮闘記

MS-Word VBA エクセル(xlsx)の図をワードドキュメント(docx)に挿入する

背景

1カ月前、このプログラムを作ったまではよかった。
すごく便利なものができたと思った。
しかし、ワードって、Normal.dotmがしばしば無くなってしまう。

空ファイルで上書きする時、何か、メッセージが出ていたのだろうが、視力が落ちているので、よく読まずにOKしてしまうからだろう。

ユーザデータから、別ドライブにバックアップを時々取ることにしていたが、
既に、マクロの無くなったNormal.dotmが張り付けられた後だった。
たまに、マクロを使おうとしたときに、
???なぜアドインのタブが無い?と気づく。時すでに遅し。

この失敗を何度繰り返したか・・・
幸い、一月しかたっていないので、プログラムの再現は、難しくは無いだろう。
それでも、1日くらいかけて作ったプログラム。半日で復元できても、
大いなる無駄。これを繰り返さないため、まず、バックアップ取るプログラムに、ファイルサイズをチェックする機能を付けた。
それから、Normal.dotmを容易にバックアップとれるよう、cygwinのHOMEにリンクを置いた。
今後は、プログラムを作る都度に、すぐにdotmをチェックしてバックアップを取る!さらに、ここにアップする。と誓う。

VBAコード

Sub locate_xlsChart()
'表の上部の行にブック名,シート名,チャート名を既述しておき、
'末尾行に、指定チャートをメタファイル貼り付けする
'ブック名は、フルパスで。

    Set atbl = Selection.Tables.Item(1)  '選択テキストの
    nrow = atbl.Rows.Count
    Set xl = CreateObject("Excel.Application")
    xl.Visible = True
    For ir = 1 To (nrow - 1)
    '==========コピー元情報取得
      txt = atbl.Rows(ir).Cells(1).Range.Text
      nspace = 2 '何故か2
      If Len(txt) <= nspace Then GoTo skip
      infos = Split(txt, ",")
      f_bk = infos(0) 'ブック名
      f_st = infos(1) 'シート名
      f_ct = infos(2) 'チャート名
      f_ct = Mid(f_ct, 1, Len(f_ct) - nspace)
    '==========コピー・貼り付け
      With xl.Workbooks.Open(f_bk)
        With .worksheets(f_st)
          Set ct = .Shapes(f_ct)
          ct.Copy
        End With
        .Close SaveChanges:=False
      End With
      
      Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteMetafilePicture
      Selection.MoveRight (1)
skip:
    Next
    xl.Quit
End Sub