Wordの表からの転記でどハマリ…… - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

　今日、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ワークシートのＡ列に書き込む処理。このマクロは、WordのDocumentを開いて、表のタイトルを選択してから実行することを前提としている。

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

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

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

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

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

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

f:id:akashi_keirin:20170223213113j:plain