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

2011年11月10日

,

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

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

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

このマクロでできること

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

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

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

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

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

マクロの解説

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

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

このときのエラー番号は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

関連記事

-コード
-,