Wordの表の各セルの文字列を利用しやすくする

Wordの表の中の文字列を取得するクラス

WordTableOperatorクラス

クラスモジュールを挿入して、オブジェクト名を「WordTableOperator」にした。

とりあえず、次のようなコードを書いた。

リスト１

Option Explicit
'フィールド'
Private wordApp_ As Word.Application
Private wordDoc_ As Word.Document
Private wordTable_() As Word.Table
Private isReady_ As Boolean
'アクセサ'
Public Property Get wordApp() As Word.Application
  Set wordApp = wordApp_
End Property
Public Property Get wordDoc() As Word.Document
  Set wordDoc = wordDoc_
End Property
Public Property Get wordTable(ByVal i As Integer) As Word.Table   '……(1)'
  Set wordTable = wordTable_(i) 
End Property
Public Property Get isReady() As Boolean
  isReady = isReady_
End Property
'コンストラクタ'
Private Sub Class_Initialize()
On Error GoTo ErrorCatch
  Set wordApp_ = GetObject(, "Word.Application")    '……(2)'
  Set wordDoc_ = wordApp_.ActiveDocument    '……(3)'
  Dim i As Integer
  ReDim wordTable_(wordDoc_.Tables.Count)    '……(4)'
  For i = 1 To UBound(wordTable_)    '……(5)'
    Set wordTable_(i) = wordDoc_.Tables(i)
  Next
  isReady_ = True    '……(6)'
  Exit Sub
ErrorCatch:    '……(7)'
  isReady_ = False
End Sub
'メソッド'
Public Function getTextFromCell(ByVal tableNum As Integer, _
                        ByVal rowNum As Integer, _
                        ByVal colNum As Integer) As String    '……(8)'
On Error GoTo ErrorCatch
  Dim str As String
  str = wordTable_(tableNum).Cell(rowNum, colNum).Range.Text    '……(9)'
  getTextFromCell = str    '……(*)'
  Exit Function
ErrorCatch:
  getTextFromCell = ""    '……(10)'
End Function

少し長くなった。ちょっと説明をば。

アクセサのところの(1)、

Public Property Get wordTable(ByVal i As Integer) As Word.Table
  Set wordTable = wordTable_(i) 
End Property

については、

akashi-keirin.hatenablog.com

コチラを参照。プロパティを配列にしている。

この場合は、Wordドキュメント内にある表を、配列として保持するようにしている。

さて、今回は珍しくコンストラクタを使う。

WordTableOperatorクラスのインスタンスが生成される時点でアクティブになっているWordアプリケーション及びドキュメントをセットしてしまうことにする。

まず、(2)の

Set wordApp_ = GetObject(, "Word.Application")

では、Wordアプリケーションのインスタンスを変数にセットするのに、GetObject関数を用いている。

akashi-keirin.hatenablog.com

このときにも使った方法だが、既に開いているWordアプリケーションを取得するため、このやり方にしている。

(3)の

Set wordDoc_ = wordApp_.ActiveDocument

で、現在アクティブになっているWordドキュメントを変数にセット。

この段階で、Wordドキュメント内にいくつの表があるかは判明しているので、(4)の

ReDim wordTable_(wordDoc_.Tables.Count)

で、配列用の変数wordTable_()を表の数でReDimしている。

(5)からの３行、

For i = 1 To UBound(wordTable_)    '……(5)'
  Set wordTable_(i) = wordDoc_.Tables(i)
Next

では、Wordドキュメント上の表を、配列wordTable_()に格納している。

Wordドキュメント上の表は、DocumentオブジェクトのTablesコレクションで取得できるので、Tablesコレクションのインデックスに1から順に数字を入れていけばそれぞれのTableオブジェクトが取得できる、という仕掛けだ。

続いて(6)。ここまでたどり着いたということは、エラーが出ていないということになるので、ここで

isReady_ = True

としてisReadyプロパティをTrueにしてやる。isReadyがTrueだということは、表が取得できているということなので、メインのコードで条件分岐に使うことができる。

なお、ここまでの過程でエラーが出ていたら、(7)の

ErrorCatch:
  isReady_ = False

に飛んでくるので、isReadyプロパティをFalseにして終了。

あとはメソッド。とりあえず１つだけにしている。

どうでもいいけど、「getTextFromCell」って、PANTERAの"Cowboys From Hell"みたいだな、オイｗ

(8)の

Public Function getTextFromCell(ByVal tableNum As Integer, _
                        ByVal rowNum As Integer, _
                        ByVal colNum As Integer) As String

を見たら分かるように、

• 第１引数：表の番号
• 第２引数：表内の行番号
• 第３引数：表内の列番号

の３つを渡すと、セル内の文字列を返す、という形にしている。

(9)の

str = wordTable_(tableNum).Cell(rowNum, colNum).Range.Text

で指定したセルから文字列を取得。

なお、途中でエラーが出たら、(10)の

getTextFromCell = ""

で""を返すようにした。

動作確認

標準モジュールに次のコードを書いて、動作確認した。

リスト２

Public Sub testWordTable01()
  Dim wtOperator As WordTableOperator
  Set wtOperator = New WordTableOperator
  Dim str As String
  If wtOperator.isReady = True Then
    str = wtOperator.getTextFromCell(1, 2, 2)    '……(1)'
    Debug.Print "表1の2行2列目セル内の文字列は、" & _
                Len(str) & "字ですわ。"
    Debug.Print "右端の文字のAsciiコードは、" & _
                getAsciiCodeOfChar(Right(str, 1)) & "番でんねん。"    '……(2)'
    Debug.Print "右端から２番目の文字のAsciiコードは、" & _
                getAsciiCodeOfChar(Mid(Right(str, 2), 1, 1)) & "番だすな。"    '……(3)'
  End If
  Set wtOperator = Nothing
End Sub
Private Function getAsciiCodeOfChar(ByVal objStr As String) As Integer
  Dim i As Integer
  For i = 0 To 255
    If Chr(i) = objStr Then
      getAsciiCodeOfChar = i
      Exit Function
    End If
  Next
  getAsciiCodeOfChar = 266
End Function

(1)の、

str = wtOperator.getTextFromCell(1, 2, 2)

では、getTextFromCellメソッドに引数（1, 2, 2）を渡しているので、

１番目の表の２行２列目のセルに入っている文字列を寄こせや！

ということになる。んで、得られた文字列を変数strにセットしている。

ちなみに、

１番目の表の２行２列目のセルに入っている文字列

ってのは、見かけ上は

「吉岡　稔真」です。

(2)の

getAsciiCodeOfChar(Right(str, 1))

では、getAsciiCodeOfCharメソッドに、(1)で得られた文字列（str）の右端の文字の文字コード番号を取得している。

これはまあ、Right関数だけだから簡単。

(3)の

getAsciiCodeOfChar(Mid(Right(str, 2), 1, 1))

がちょっとややこしい。

まず、

Right(str, 2)

で右端の２文字を抜き出して、その２文字に対してMid関数を使うことで、

右端の２文字の１文字目

すなわち、

右端から２文字目

を取得している。

まあ、

Mid(str, Len(str) - 1, 1)

でもいいですね。ハイ。

実行結果

こうなった。

指定のセル内の文字列は、見かけ上は「吉岡　稔真」の５文字（全角スペース含む）のはずだが、７文字となっている。

６文字目の文字コードが「7」、７文字目の文字コードは「13」となっている。

再びコチラによると、

ということなので、

Wordのセル内の文字列の末尾には、「ハナクソ」と「改行文字」がくっついている

ということらしい。

最後に

ということは、リスト１の(*)のところを

str = Left(str, Len(str) - 2)

とするだけで良いということになるなあ。

あとは、このクラスの使い勝手をいかに上げるか、だな。

「ゼロ文字目を返せや、コラ！」という無理難題にVBAさんはどう答えるのか

Left関数、Right関数の第２引数

Left関数、Right関数の第２引数が「0」だったらどうなるのか

やってみた。

イミディエイト・ウインドウに次のコードを入力して[Enter]を押す。

リスト1-1

?Left("吉岡　稔真",0)

リスト1-2

?Right("吉岡　稔真",0)

実行結果

どうも、第２引数に「0」を指定すると""が返されるみたいです。

結論

「左（右）から0文字目を返せや、コラ！」みたいな無理難題に対して、エラーを返すんではなくて、笑顔で（？）""を返すというのは、ありがたい仕様ですね。

@akashi_keirin on Twitter

「ハナクソ」の正体が分かった……？

ハナクソの正体が分かった？？？

「ハナクソ」とは

「ハナクソ」というのは、

akashi-keirin.hatenablog.com

Wordの表からExcelのセルに値を転記したときに、テキストの末尾にくっついてくるナゾの物体のこと。

私の職場の環境（Office2010）では、まるでハナクソが末尾にひっついているように見えたことから、私が勝手に「ハナクソ」呼ばわりしていたのだった。

「ハナクソ」の正体を突き止める方法

近々またWordの表からExcelワークシートへの転記が必要になりそうなので、「ハナクソ」対策をどうしようか考えていた。

このときは、Replace関数を使用して「ハナクソ」を除去したのだった。

また、その後、このときは、Left関数を使って右端の「ハナクソ」だけを削る、という方法で「ハナクソ」を除去したのだった。

しかし、いづれにしても、

「ハナクソ」の正体を突き止めることから目を背けた消極的な対応

には違いなく、非常に心が痛むのであった。

そんなとき、ひらめいたのですよ。あばれはっちゃくばりに！

Chr関数使えばよくね？

なーんて。

もうね、おチャクラ全開ですわよ。

で、やってみた。

リスト1-1

Public Sub testWordTable03()
  Dim wdDoc As WordDocument
  Set wdDoc = New WordDocument    '……(1)'
  Dim str As String
  If wdDoc.isReady = True Then
    str = wdDoc.wordTable(1).Cell(2, 2).Range.Text    '……(2)'
    Call searchBooger(Right(str, 1))    '……(3)'
  End If
  Set wdDoc = Nothing
End Sub

リスト1-2

Private Sub searchBooger(ByVal booger As String)
  Dim i As Integer
  For i = 0 To 255    '……(4)'
    If Chr(i) = booger Then    '……(5)'
      Debug.Print "ハナクソの文字コードは、" & i & " 番ですがな。"    '……(6)'
      Exit Sub
    End If
  Next
  Debug.Print "ハナクソには文字コードがなかったようだ。(´･ω･`) ｼｮﾎﾞｰﾝ"
End Sub

まず(1)の

Set wdDoc = New WordDocument

は、自作のWordDocumentクラスのインスタンスを生成しているだけ。簡単に説明しておくと、インスタンス化するときにアクティブなWord.ApplicationオブジェクトとWord.Documentオブジェクトを取得して、Document上のTableオブジェクトを配列に格納してしまう働きを持ったクラスです。

だから、(2)の

str = wdDoc.wordTable(1).Cell(2, 2).Range.Text

こんな書き方で、

１つ目の表の２行２列目セルのテキスト

が取得できるのだと思ってください。

ちなみに、こうやって取得したテキスト（変数strの中身）の右端には、あの忌まわしい（ｗ）「ハナクソ」がひっついております。

んで、(3)の

Call searchBooger(Right(str, 1))

では、自作メソッドsearchBoogerに引数として「ハナクソ」を渡している。

ちなみに、「Booger」というのは、アメリカ英語で「ハナクソ」のことらしい。案外こういう身近な言葉って英語で言えないよな。

さて、SearchBoogerメソッドの処理だが、まず(1)の

For i = 0 To 255

でForループのカウンタを0～255にしているのは、Chr関数の引数が0～255だから。

(5)の

If Chr(i) = booger Then

では、文字コードで指定した文字が引数としてこのメソッドに渡されたbooger（正体は「ハナクソ」）と一致しているかどうかを判定。一致していたら、(6)の

Debug.Print "ハナクソの文字コードは、" & i & " 番ですがな。"

で文字コード番号をイミディエイト・ウインドウに表示しよう、というわけ。

実行結果

おおっ！　つ、ついに「ハナクソ」の正体が白日のもとに……（感涙）。

んで、Chr(7)って何なの……？？？

コチラのページによると、

こういうことのようなんだが、

で、「警告音を鳴らす」って何なの？？？
何でこんなもんがWordの表のセル内の文字列にくっついてんの？？？

と、ナゾがさらに深まっただけなのであった。。。

おわりに

Chr(7)とは何なのか、「BEL」とは何なのか、そして、なぜWordの表のセル内文字列にそんなもんがひっついているのか、誰か知っている人があったら教えろてください。

@akashi_keirin on Twitter

LotusScriptのメソッド実行に成功した

LotusScriptのメソッド使用に成功した

少し前、コチラの記事

akashi-keirin.hatenablog.com

で泣き言を言ったら、こんな過疎ブログにもかかわらず大勢の方がアドヴァイスをくださった。なんとありがたいことよ……。

あれこれ試してみて、なんとかうまく行ったので、ご報告もかねてコチラでお返事させていただきます。

thom (id:t-hom)さん、id:imihitoさん、そしてExcelVBAer (id:x1xy2xyz3)さん、

ホントーに、あざす!!!!!!!!

【参考】前回使用したコード

リスト０

Dim notesSession As Object
Dim notesDatabase As Object
Dim notesDocument As Object
Dim notesUIWorkSpace As Object
Dim notesUIDocument As Object    '……(1)'
Set notesSession = CreateObject("Notes.NotesSession")
Set notesUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set notesDatabase = notesSession.GetDatabase("", "")
notesDatabase.OpenMail
Set notesDocument = notesDatabase.CreateDocument()
notesDocument.Save False, False
Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)
notesUIDocument.Print(0)    '……(*)'

この、(*)のところがうまく行かない、というお話でした。

目次

読むのがメンドクサイ人のために、今回は目次をつけます。「成功」のところだけ読んでもらったら良いかと。

• 型指定の厳密化（失敗）
• メソッド名に[]（失敗）
• CallByName関数の使用（成功）

型指定の厳密化

まず、id:imihitoさんのアドヴァイスに従って、単にObject型で指定していた変数を厳密に型指定することにした。

ExcelVBAer (id:x1xy2xyz3)さんによると、参照設定できるということなので探してみると、確かにあった。

職場で見ただけなのでうろ覚えだけど、「Lotus」で始まるやつです。

んで、喜び勇んで参照設定にチェックを入れ、リスト０の(1)を

Dim notesUIDocument As NotesUIDocument

としてみたが、うまく行かなかった。今にして思えば、変数名と型名が同じだったのがマズかったのかも知れん。

ただ、仮に参照設定してうまく行ったとしても、ノーツの入っているPCでしか動かないのでは困るなあ。

というわけで、このやり方は見送ることにした。

メソッド名に[]

これが一番簡単な対応なので期待したのだが、

リスト０の(*)を

notesUIDocument.[Print]0

としてみたが、何も起こらなかった……（エラーは出ていたかも）。

CallByName関数の使用

「CallByName関数」なんてものがあることを知らなかったので、ちょっとggってみた。

すると、たとえばコチラには、

オブジェクトに対してメソッドを実行します。また、オブジェクトのプロパティを設定または取得します。

パラメータ

ObjectRef

必ず指定します。オブジェクト型 (Object) です。プロパティまたはメソッドを公開するオブジェクトへのポインタを指定します。

ProcName

必ず指定します。文字列型 (String) です。オブジェクトのプロパティまたはメソッドの名前を含む文字列式を指定します。

UseCallType

必ず指定します。呼び出されるプロシージャの種類を表す CallType 列挙型 型の列挙体のメンバです。CallType の値は、Method、Get、Set のいずれかです。

Args

(省略可能。) パラメータ配列型 (ParamArray) です。呼び出されるプロパティまたはメソッドに渡す引数を含むパラメータ配列を指定します。

だってさ。おお、これならなんとかなりそうだ！

ちなみに、第３引数の「UseCallType」の指定には定数が使える。コチラによると、メソッド呼び出しの場合は「VbMethod」（実体は「1」）を使えば良い。

リスト１

Dim notesSession As Object
Dim notesDatabase As Object
Dim notesDocument As Object
Dim notesUIWorkSpace As Object
Dim notesUIDocument As Object
Set notesSession = CreateObject("Notes.NotesSession")
Set notesUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set notesDatabase = notesSession.GetDatabase("", "")
notesDatabase.OpenMail
Set notesDocument = notesDatabase.CreateDocument()
notesDocument.Save False, False
Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)
CallByName notesUIDocument, "Print", VbMethod, (0)    '……(1)'
notesUIDocument.Close True    '……(2)'

(1)の

CallByName notesUIDocument, "Print", VbMethod, (0)

では、CallByName関数に４つの引数を渡している。

今回は、

NotesUIDocumentクラスのオブジェクトであるnotesUIDocumentのPrintメソッドに引数「0」を渡して実行

したいわけなので、引数にはそれぞれ

• 第１引数（対象のオブジェクト）にはnotesUIDocument
• 第２引数（メソッド名）にはPrint
• 第３引数（呼び出されるものの種類）にはVbMethod
• 第４引数（メソッドに渡す引数）には(0)

を指定した。ちなみに、notesUIDocumentクラスのPrintメソッドに引数「0」を渡して実行すると「１部だけ印刷」になる。

あとは、(2)の

notesUIDocument.Close True

で作成したメールを閉じる。このコードは前回もこのまま実行できたのでCallByName関数は不使用。

実行結果

職場のPCでしか実験できないので、画像がなくてすみません。

実行すると、ノーツの画面に作成したメールが一瞬表示され、すぐに閉じられる。並行してプリンタからメール文面が出てきた。おおっ、うまく行ったぞ！

第４引数の「0」を「()」で括るというのが必要なのかどうかよく分かっていないが、とりあえずこれでうまく行っている。

最後に注意

ひとまずこれで意図したとおりの結果が得られたわけだが、１点だけ注意。

今回のコードを利用したマクロでは、メールを作成するだけして送信せずに印刷だけして閉じているので、メールが作成されるごとにドラフトに未送信のメールがばかすか溜まっていきます。添付ファイル次第ではすぐにメールが送れなくなってしまうので注意が必要です。

ともあれ、これで

多くの宛先にそれぞれ異なるメールを送る

というときに、

一旦全てプリントアウトして文面をチェックしてから一気に自動送信

という形に持って行けそうです。

アドヴァイスをくださった皆様、

あざーしたっ!!!!!!!!

Wordの余白を除いたページ幅の中心位置の割り出し方について

Wordのページ中心位置に関する大いなる錯誤

偶然の一致だった

前回、コチラの記事で、

tmp = CLng(Word.PointsToMillimeters(objDoc_.PageSetup.PageWidth))

では、ページ横幅の中心位置を割り出しているのだが、なぜこれで中心が割り出せるのか分からない。

などと書いていた。

だが、id:imihitoさんからのご指摘

PageSetupは余白を含んだページの大きさを取得する

にある通り。すなわち、

余白を含めたページ幅（単位はpoint）のmillimeter換算値が、たまたま余白を除いたページ幅の半分（単位はpoint）とだいたい同じだっただけ

というオソロシイことが判明ｗｗｗ

無知とはオソロシイ……。

コードの改良　その１

そんなわけで、まずは

余白を除いたページ幅の半分の割り出し

をば。

ページの幅に関するプロパティは画像に示した通り。

また、

この画像の通り、

• X：余白を含めたページ幅
• Y：左余白
• Z：右余白
• a：ハンコ画像の幅

とすると、まず余白を除いたページ幅の半分は、

(X - (Y + Z)) / 2

で求めることができる。

ハンコ画像を中心に持ってくるためには、ハンコ画像の左端をハンコ画像の幅の半分だけページ中心位置からずらしたところに持ってきたら良いので、

(X - (Y + Z)) / 2 - a / 2

整理して

(X - (Y + Z + a)) / 2

とすれば良いはず。

リスト１

Dim wdPageSetup As Word.PageSetup    '……(1)'
Set wdPageSetup = objDoc_.PageSetup
Dim tmpShape As Word.Shape    '……(2)'
Set tmpShape = objDoc_.Shapes.AddPicture(imgPath)    '……(3)'
With wdPageSetup
  tmpShape.Left = _
    (.PageWidth - (.LeftMargin + .RightMargin + tmpShape.Width)) / 2    '……(4)'
  tmpShape.Top = -(.TopMargin / 2)    '……(5)'
End With

まず、(1)では、id:imihitoさんのアドヴァイスに従って、

Dim wdPageSetup As Word.PageSetup
Set wdPageSetup = objDoc_.PageSetup

このように、WordのPageSetup型のオブジェクト変数を用意して、操作対象であるobjDoc_（Wordドキュメント）のPageSetupをオブジェクトとして格納している。へえ、こんなこともできるんですねえ。

んで、(2)。前回ハマったポイントです。

コチラは、id:imihitoさん、それからツイッターのフォロワーさんから一斉にツッコミが入ったポイントで、要するに、Excelさんの立場からすると

「Shape」ってオメー、それだけだとExcelのShapeだかWordのShapeだか分かんねーよ、バカ!!!!!!!!

ということのようですね。よく考えたら当たり前だ。だから、

Dim tmpShape As Word.Shape

と、WordのShapeであることを明示した。

id:imihitoさん、フォロワーさん、あざす！

(3)は、これまたid:imihitoさん、フォロワーさんの両方からご教示くださったポイント。お二方のアドヴァイスに従って、

Set tmpShape = objDoc_.Shapes.AddPicture(imgPath)

このように、いきなりハンコ画像を変数にセットした。実行時の挙動を見ていると、変数にセットするだけで勝手にLeft = 0, Top = 0の位置に配置されるようだ。一旦配置してからでないとダメだと思っていたのですよ。

これまたid:imihitoさん、フォロワーさん、あざす！

ここまできたら、後はハンコ画像の位置を決めるだけ。

まずは(4)の

tmpShape.Left = _
  (.PageWidth - (.LeftMargin + .RightMargin + tmpShape.Width)) / 2

で左余白を除いたページ左端からの距離を定め、

(5)の

tmpShape.Top = -(.TopMargin / 2)

でハンコ画像の上端の位置を定めている。上余白の半分だけ上にめり込ませるような感じにした。

前回のリスト１に比べてなんとスッキリしたコードになったことか！

あらためてid:imihitoさん、フォロワーさん、あざす！

実行結果

実行してみた。

Wordドキュメントに、

まずハンコが設置され、

水平移動、

そして、垂直移動して完成。

って、ん……？？？

なんか、ちょっと右にズレとるぞ……。「斡旋決定通知書」という見出しは中央揃えにしているので、「定」に重なるはずなんだが……。

結論

今度こそ、なぜちょっとだけ右にズレるのか分かりませぬ……。

@akashi_keirin on Twitter

私はResumeの意味が分かっていなかった

Resumeステートメントの意味が分かっていなかった

Resumeステートメントの意味

久しぶりに『Excel VBA本格入門』（大村あつし著）を読み返していたら、

「Resumeステートメント」を引数なしで使うと、エラーの原因となったステートメントに制御が戻ります。

とあった。

( ﾟдﾟ)ﾎﾟｶｰﾝ

え？？？　そうだったの？？？

知らんかった……。

てっきり「Resume Next」で一つなんだと思っていたよ……。

あー、恥ずかし。

体系的に学んでいないと、こういう初歩的なところでつまづいているんだよなあ。

ということは、エラーが出た後、GoToでエラー処理ブロックに飛んだ後、リトライできるってことか。

……というわけで、やってみた。

PDF変換クラスを改良する

このとき作成したDocPDFConverterクラスの、WordドキュメントをPDFに変換して保存するメソッドなんだが、

同名のPDFが開いている状態で実行するとエラーが出る

という欠陥があった。

こいつをResumeステートメントを活用して改良してみよう。

コードの改良

リスト１

Public Sub convertDocToPDF(ByRef doc As Word.Document, _
                           ByVal tgtFolderName As String, _
                           Optional ByVal addStr As String = "")
  Set objDoc_ = doc
  objPath_ = doc.Path
  objFileName_ = doc.Name
  Dim nameStr As String
  nameStr = Left(objDoc_.Name, InStrRev(objDoc_.Name, ".") - 1)
  objDoc_.Range(1, 1).Select
  objDoc_.ExportAsFixedFormat _
    OutPutFileName:=objPath_ & "\" & tgtFolderName & "\" & addStr & nameStr & ".pdf", _
    ExportFormat:=wdExportFormatPDF    '……(*)'
  DoEvents
End Sub

(*)のところでPDFファイルを生成するわけだが、引数OutPutFileNameに渡すファイルフルパスと同じフルパスを持ったPDFファイルが開いている状態で実行するとエラーが出る。

そこで、(*)のところを次のリスト２のように書き換える。

リスト２

  On Error GoTo ErrorCatch    '……(1)'
  objDoc_.ExportAsFixedFormat _
    OutPutFileName:=objPath_ & "\" & tgtFolderName & "\" & addStr & nameStr & ".pdf", _
    ExportFormat:=wdExportFormatPDF    '……(*)'
  DoEvents
  Exit Sub    '……(2)'
ErrorCatch:
  nameStr = nameStr & "_"    '……(3)'
  Resume    '……(4)'

まず、エラーが発生源である(*)の手前のところで、(1)のように

On Error GoTo ErrorCatch

と書いておく。これで、(*)のところでエラーが出たらErrorCatchラベルにジャンプすることになる。

エラーが出ていなければ、ErrorCatchラベル以下のコードを実行する必要はないので(2)の

Exit Sub

で処理を抜ける。

で、エラーが出ていた場合は、(3)、(4)が実行されることになる。

(3)の

nameStr = nameStr & "_"

では、生成されるファイル名の素材である変数nameStrに「_」（半角アンダースコア）を追加している。

これで、エラーが出たときとは異なるファイル名になるはず。

その後、(4)の

Resume

で(*)の処理にリトライすることになる。

もしそこで再度エラーが出たら、ErrorCatchラベルのところにジャンプして、さらにファイル名に"_"を追加してリトライ、ということになるので、無事に保存が終わるまで繰り返すことになるはず。

実行結果

普通に実行したら「【写】実験用サンプル.pdf」というファイルが生成されるはずの処理を、

この状態で実行してみた。

この通り、無事にファイル名を変えてPDFが保存された。

結論

やはり、基本が大切です。

画像の配置でいらいらした

ページ横幅の中心位置を割り出そうとしたら謎だらけだった

問題のコード

写しPDF作成マクロを改良して、常にページ横幅の中心部分にハンコ画像が配置されるようにしようとしたら、謎だらけだったので書き残しておく。

リスト１

Dim objRange As Word.Range
Set objRange = objDoc_.Range(0, 0)
objRange.Select
Dim tmp As Long
tmp = CLng(Word.PointsToMillimeters(objDoc_.PageSetup.PageWidth))    '……(1)'
Dim tmpShape As Object    '……(2)'
With objDoc_
  .Shapes.AddPicture fileName:=imgPath, _
                          Top:=-20, _
                         Left:=0            '……(3)'
  Set tmpShape = .Shapes(.Shapes.Count)    '……(4)'
  tmp = tmp - CLng(tmpShape.Width / 2)    '……(5)'
  tmpShape.Left = tmp
End With

変数objDoc_にはWordのDocumentが、変数imgPathには、ハンコ用画像のフルパスが入っていると思ってください。

謎その１

リスト１の(1)、

tmp = CLng(Word.PointsToMillimeters(objDoc_.PageSetup.PageWidth))

では、ページ横幅の中心位置を割り出しているのだが、なぜこれで中心が割り出せるのか分からない。

コチラによると、

取得またはページの幅をポイント単位で設定します。読み取り/書き込み1 つです。

ということなので、

tmp = (objDoc_.PageSetup.PageWidth) / 2

こうしたら良さそうなものなんだが、実際こうすると、

とんでもなく右にずれる。

リスト１の(1)のようにすると

こんなふうにちゃんと真ん中になる。わけ分からん。

謎その２

リスト１の(2)のところ、

Dim tmpShape As Shape

と、Shape型にしたら良さそうなものなんだが、Shape型にすると「型が一致しません」エラーが出る。

わけ分からん。

しかも、「Dim tmpShape As」まで入力して半角スペースを入れると、インテリセンスで候補が出るんだが、

このように「Shape」が２つも出てくるし……。

んで、どっちを選んでも「型が一致しません」エラー。

マジでわけ分からん。

謎その３

画像を中心に据えるためには、画像の左端の座標が、

[ページの中心]－[画像の横幅の1/2]

になっていればよい。

画像の横幅を取得するのに、

LoadPicture関数

を使おうとしたらアンタ、

pngファイルには未対応とか!!!!!!!!

なんでやねん！

というわけで、リスト１の(3)～(5)のような、非常に面倒な方法を使った。

まず、(3)の

objDoc_.Shapes.AddPicture fileName:=imgPath, _
                               Top:=-20, _
                               Left:=0

で一旦ページの左端に画像を追加した。

追加した画像は、Shapesコレクションの末尾に追加されているはずなので、ShapesコレクションのCountプロパティの値をShapesコレクションのインデックスにセットしたら追加したてのShapeオブジェクトが取得できるはず。

というわけで、(4)の

Set tmpShape = .Shapes(.Shapes.Count)

で変数tmpShapeに追加したばかりの画像をセット。

あとは、(5)の

tmp = tmp - CLng(tmpShape.Width / 2)

で、画像の横幅の半分をページ中心の座標から引いてやれば、画像がほぼ中心にセットされることになる。

まとめ

• PageSetupオブジェクトのPageWidthプロパティを半分にしているのにページ横幅の中心の値が得られないのはまるで意味が分かりません
• PointsToMilliMeters関数の戻り値だけでページ横幅の中心が得られるのが意味分かりません
• ShapeオブジェクトをShape型の変数にセットしようとしただけなのに「型が一致しません」とか言われるのは納得がいきません
• LoadPicture関数がpng画像に対応していないのは意味が分かりません

とにかく、意味の分からないことばかりでいらいらしました。