【コード】文書中のテキストボックス内の文字列を別紙に書出す

先日テキストボックス内の文字列に対する置換処理のマクロをご紹介しました。

今回は、テキストボックス内にある文字列を書出すマクロです。

今の仕事でどうしても必要になっており、作ってみました。

このマクロでできること

文書中のテキストボックス内の文字列を、新しい文書に書出します。

この記事でのテキストボックスとは、図に書かれている文字列や吹き出しの文字列を意味します。

グループ化されているテキストボックスからもテキストを抽出できます。

これは、きぬあささんのブログでご紹介いただいた方法を使いました。

描画キャンバスにおいても、同じような考え方で応用できそうですが、まだ検証が終わっていないので今回は除外いたしました。

マクロの解説

文書中の全ての図から文字列を探します。

図が画像の場合には、文字列がありませんので、文字列を取得しようとするとエラーになります。

このときのエラー番号は5917です。

エラーが出ていない場合に取得したテキストを文書に貼り付けています。

エラーが出た場合には、エラーをクリアします。

マクロ


Sub テキストボックスのテキスト抽出()
 Dim aShape As Shape   '図
 Dim grpShape As Shape  'グループ化された図
 Dim myText As String  '抽出する文字列
 Dim actDoc As Document '処理対象の文書
 Dim myDoc As Document  '新規で開いた文書
  
 Set actDoc = ActiveDocument
 Set myDoc = Documents.Add
 
 actDoc.Activate
 
 For Each aShape In ActiveDocument.Shapes
  Select Case aShape.Type
   Case msoGroup
   'グループ化されている場合の処理
    For Each grpShape In aShape.GroupItems
     On Error Resume Next
     myText = grpShape.TextFrame.TextRange.Text
     '図中にテキストの有無の判定
     If Err.Number <> 5917 Then
      myDoc.Range.InsertAfter myText
     Else
      Err.Clear
     End If
     On Error GoTo 0
    Next
    
   Case Else
   'それ以外の場合の処理
    On Error Resume Next
    myText = aShape.TextFrame.TextRange.Text
    '図中にテキストの有無の判定
    If Err.Number <> 5917 Then
     myDoc.Range.InsertAfter myText
    Else
     Err.Clear
    End If
    On Error GoTo 0
  End Select
 Next
 
 myDoc.Activate
 Set myDoc = Nothing
  
End Sub

トップへ戻る