読者です 読者をやめる 読者になる 読者になる

Wordの表からの転記でどハマリ……

 今日、Wordの表からExcelにデータを転記する簡単なマクロを作ったんですが、最初はうまいこと行っていたのに、ある瞬間から突然

f:id:akashi_keirin:20170223203230j:plain

というエラーが出て、どハマリしてしまいました……。

'参照設定でWordのオブジェクトライブラリにチェックを入れています。
  Dim objWord As Word.Application
  Dim objDoc As Document
  Set objWord = GetObject(, "Word.Application")
  Set objDoc = objWord.ActiveDocument       '(*)

 このコードの(*)のところでエラーが出る。「文書が開かれていない」とか言うけど、

f:id:akashi_keirin:20170223203235j:plain

開いとるやんけ!!!!!!!

 イミディエイト・ウインドウで「?objWord.Documents.Count」とすると、「0」が返ってくるし、もう何が何やらわけが分からなくて悪戦苦闘。

 少々パニクりつつもあれやこれやggっていると、こんなのを見つけた。曰く、

複数のWINWORDを立ち上げている場合には
GetObject は一つのインスタンスしか返しません。

だってさ。

 落ち着いて考えたら、エラーでマクロを終了したときからおかしくなったんじゃないか? 見えない状態でWord.Applicationのインスタンスが複数できてしまっていて、GetObject関数が今Documentを開いているWord.Applicationのインスタンスを返していない場合にこのエラーが出るようになったんじゃないか、と思ったわけですよ。

 で、早速

f:id:akashi_keirin:20170223203240j:plain

Word.Application.Quitを実行。

 んで、再度実行。

f:id:akashi_keirin:20170223203245j:plain

 元の表に、

f:id:akashi_keirin:20170223203250j:plain

ほれ、この通り転記された。

 エラーの原因が本当にここに書いたとおりなのかは実はよく分からない。Word.Applicationのインスタンス化も、

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

Set objWord = New Word.Application

とするとうまく行かないが、これもなぜだかよく分からない。

 

 ついでに、今回Wordの表からExcelに転記するのに使ったコードを載せておく。

Sub transferFromWordTable()
On Error GoTo myError     '……(1)
  Dim tgtRow As Integer
  tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row + 1
  Dim n As Integer
  n = tgtRow  '書き込み開始行を保持しておく
  
  Dim objWord As Word.Application
  Dim objDoc As Document
  Dim objFileName As String
  Dim objFolderName As String
  Set objWord = GetObject(, "Word.Application")   '……(2)
  Set objDoc = objWord.ActiveDocument             '……(3)
  objFileName = objDoc.Name                       '……(4)
  objFolderName = ThisWorkbook.Path & "\特別競輪優勝者\"
  
  With ThisWorkbook.Worksheets("Main")
    .Range("A" & tgtRow).Value = objWord.Selection.Text '……(5)
    Dim i As Integer
    For i = 2 To 9      '……(6)
      .Range("B" & tgtRow + i - 2).Value = _
        Replace(objDoc.Tables(1).Cell(i, 1).Range.Text, "●", "")
      .Range("C" & tgtRow + i - 2).Value = _
        Replace(objDoc.Tables(1).Cell(i, 2).Range.Text, "●", "")
      .Range("D" & tgtRow + i - 2).Value = _
        Replace(objDoc.Tables(1).Cell(i, 3).Range.Text, "●", "")
      .Range("E" & tgtRow + i - 2).Value = _
        Replace(objDoc.Tables(1).Cell(i, 4).Range.Text, "●", "")
    Next

    tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row
    For i = n To tgtRow     '……(7)
      If .Range("B" & i).Value = vbCr Then
        .Range("B" & i).Value = ""
      End If
    Next
  End With
  objDoc.Close False
  If objWord.Documents.Count = 0 Then
    objWord.Quit
  End If
  Set objWord = Nothing
  Set objDoc = Nothing
  
  Name objFolderName & objFileName As _
       objFolderName & "転記済み\" & objFileName    '……(8)

  Exit Sub

myError:
  Debug.Print Err.Number & ":" & Err.Description
  Word.Application.Quit
End Sub

 (1)はエラーが出たときの処理。myErrorラベルにジャンプして、必ずWord.Application.Quitを実行するようにしている。

 (2)でWord.Applicationをインスタンス化。

 (3)で、開いているWordのDocumentをオブジェクト変数にセット。

 (4)では、後で転記済みのDocumentを「処理済み」フォルダに移動できるようにファイルパスとファイル名を変数にセットしている。

 (5)は、Documentの選択箇所の文字列をExcelワークシートのA列に書き込む処理。このマクロは、WordのDocumentを開いて、表のタイトルを選択してから実行することを前提としている。

 (6)でWordの表のデータをExcelに転記している。

 「Document . Tables(Index) . Cell(Row , Column) . Text」で、指定した表の、行・列で指定したセルの文字列を取得することができる。

 ただ、Wordの表からExcelに転記すると、なぜか文字列の最後にハナクソみたいなやつ(●)が付着して、見苦しいこと甚だしい。だから、Replace関数で除去している。

※どうしても表示できないので、リスト内、本文内では「●」に置き換えています。

 (7)では、B列の値が「vbCr」のみだった場合に""(空白)にするようにしている。

 これもなぜだか分からないが、こうしておかないと、

f:id:akashi_keirin:20170223213113j:plain

 このような途中までしかない表を2つ続けて転記したときに、

f:id:akashi_keirin:20170223213118j:plain

 こんなマヌケな結果になるのだ。

 何度か実験して一見空白に見えるExcelのセルにvbCrが書き込まれているらしいことが分かったので、置換するようにした。

 (8)は、処理済みファイルをフォルダ移動する処理。私はよくこのやり方を使う。

 Wordからのデータ転記についてはまだよく分かっていないことも多いので、これから勉強しないとな、と思っている。

 覚書程度にちょっとだけ書き留めておくつもりが異様に長くなってしまった……。今回はよく分からずに書いている箇所も多いので、詳しい方がいろいろご指摘くださったらうれしく思います。