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