ワードマクロの改良: 長く曲がりくねった道　～　いろいろな話

2016年07月03日

ワードマクロの改良

前回マクロを使って少しブログ投稿を楽にした。

どうせならもう少し楽にしようと、少し改良を加えた。

プログラムという物は難しく作れば良いと言うものではない。

苦労して作っても、その割には何てことないと言うことは良くある。

だから時間を掛けて何から何までプログラムにやらせるのではなく、

簡単な操作で結果が得られるのであれば、

それとの組み合わせで目的を達成しようと思う。

商品としてのプログラムを作るではなく、

あくまでも便利ツールとしてのプログラムなのだから。

前回は、ワードにファイル名と画像を挿入した。

このファイル名の所を、タグにした。

タグの原型は、ブログの記事の編集でひとつだけ画像を挿入し、

ブログ編集ソフトにタグを作らせる。

例えば下記のようなものが画像表示のタグである。

この中には画像をセンタリングしたり、クリック時に

別ウィンドウで開くなどのオプションが入っている。

このタグの中の画像ファイル名[IMG_4577b]を入れ替えてやれば、

ブログ編集でいちいち画像を挿入する手間が省ける。

処理は前回と同様で、

１：VBSによる画像ファイル名の一覧作成、

２：ワードのマクロ(VBA)でタグと画像を挿入する。

前述のタグと入れ替える文字列は[RepTxt.txt]と言う名前で

同じフォルダに保存しておく。

１行目タグセンテンスで、２行目が置き換え対象文字列である。

改行コードを入れることを忘れぬように。（プログラムで読み込む為）

VBSのソースコードは以下の通りです。

'画像とタグ情報の挿入
'======================
Sub PicInsert()
Const cInfoFileNa = "FolderList2.txt" 'ファイル名一覧ファイル
Const cRepFileNa = "RepTxt.txt" 'タグ情報と入替対象文字列

Dim arr() As String
Dim arr2() As String
Dim myPath As String
Dim infoPath As String
Dim x As Integer
Dim tmp As String
Dim xTag As String
Dim xShape As Shape
Dim RepP As RepForm
RepP.tFiNa = cRepFileNa
Call RepParaGet(RepP.tFiNa, RepP.tTag, RepP.tTarget)

myPath = ActiveDocument.Path & "\"
infoPath = myPath & "\" & cInfoFileNa

Open infoPath For Input As #1
Do Until EOF(1)
Line Input #1, tmp
Loop
Close #1

arr = Split(tmp, ",")

For x = 0 To (UBound(arr) - 1)
'タグ情報の加工と挿入
arr2 = Split(arr(x), ".") ’ファイル名から拡張子を取る
xTag = Replace(RepP.tTag, RepP.tTarget, arr2(0)) 'フィル名を入れ替える
Selection.TypeText Text:=xTag & vbCrLf

'画像の挿入
Selection.InlineShapes.AddPicture FileName:= _
myPath & arr(x), LinkToFile:=False, _
SaveWithDocument:=True

'改行
Selection.TypeText vbCrLf & vbCrLf & vbCrLf
Next
Set xShape = Nothing
End Sub

タグ：ワード,マクロ,VBS,VBA