これまでに、「【コード】文書中のテキストボックス内の文字列を別紙に書出すコード」と「【コード】文書中のテキストボックス内の文字列を別紙に書出す（その２）」を紹介しました。
上記のマクロでは、描画キャンバス内のテキストボックスを処理できていません。
さらに、グループ内のさらにグループ化されたテキストボックスも処理できていません。
そのようなわけで、今回は描画キャンバスやグループ化をもう少し掘り下げて検証します。
なお、今回の記事もまだ完璧ではありません。プログラムを簡単にするために、ヘッダーやフッター内のテキストボックスは処理対象から外しているからです。
WordのヘッダーやフッターをVBAで処理するには変則的なことをする必要があります。バグのような特殊な仕様があるからです。
そのため、理解しやすいように、本文内にあるテキストボックスだけを処理対象にしてみました。
なお、このマクロにもまだエラーが発生することがあります。「その４」以降に続きます。
＜目次＞
このマクロでできること
本文中に書かれているテキストボックス内の文字列を新規文書に書き出します。
ヘッダーやフッター内のテキストボックスは処理対象外です。
描画キャンバス内のテキストボックスやグループ化されているテキストボックスも処理対象にしています。
また、描画キャンバス内のグループ化されたテキストボックス内のグループ化されたテキストボックス、、、、など、考え始めると結構複雑な構造になりえます。
このような場合には、再帰処理をして描画キャンバスやグループを取り扱います。
以下のような描画キャンバス内にグループ化されたテキストボックスがある場合にもテキストを書き出せます。
以下のように新規文書にテキストボックス内の文字列を書き出します。（以下の例は、Word 2007で実行した場合）
マクロ１の解説
GetTextという名前のサブプロシージャーを再帰呼び出しという方法で実行します。
CanvasItemsプロパティやGroupItemsプロパティを用いて描画キャンバス内、グループ内のShapeオブジェクトを特定します。
マクロ１
Sub テキストボックスのテキスト抽出3() Dim myShape As Shape '図 Dim actDoc As Document '処理対象の文書 Dim newDoc As Document '新規で開いた文書 Set actDoc = ActiveDocument Set newDoc = Documents.Add For Each myShape In actDoc.Shapes Call GetText(myShape, newDoc) Next Set actDoc = Nothing Set newDoc = Nothing End Sub Private Sub GetText(aShape As Shape, myDoc As Document) Dim InShape As Shape 'グループ内の図 Select Case aShape.Type 'キャンバスの場合の処理 Case msoCanvas For Each InShape In aShape.CanvasItems Call GetText(InShape, myDoc) Next InShape 'グループ化されている場合の処理 Case msoGroup For Each InShape In aShape.GroupItems Call GetText(InShape, myDoc) Next InShape '上記以外の場合の処理（テキスト抽出） Case Else If aShape.TextFrame.HasText = True Then myDoc.Range.InsertAfter aShape.TextFrame.TextRange.Text End If End Select End Sub
マクロ２の解説
実は、マクロ１は、Word 2003, Word 2007とWord 2013以降のバージョンであれば動きます。Word 2010では動きません。
私はWord 2010でサンプルコードを書いていたので、理論上は動くと思われるマクロ１が動かなくて無駄に考え込んでしまっていました。
Word 2010では以下のようなエラーメッセージが表示されます。
これはバグだと思います。何が問題なのでしょうか。
以下の箇所でエラーで止まります。
つまり、For Each Next ステートメントが問題になっているのです。ここでメンバー（InShape）を取り出せなくて、エラーになります。
GroupItemsはあるはず、、、と思ってGroupItems.Countプロパティを調べると数が表示されるのです。
納得いかないけど、とりあえずインデックス番号でオブジェクトを特定しようか、、と思ってマクロ２の用に修正したら動きました。
「おかしいなー」と思ってEvernoteに書きためたバグのメモを探してみると、、、、。ありました（笑）。
この挙動については以前他のプログラムでも起こりました。Word 2010のバグのような現象としてメモしてました。ひとまずは、マクロ２のように修正して動くのでよしとします。
マクロ２
Sub テキストボックスのテキスト抽出4() Dim myShape As Shape '図 Dim actDoc As Document '処理対象の文書 Dim newDoc As Document '新規で開いた文書 Set actDoc = ActiveDocument Set newDoc = Documents.Add For Each myShape In actDoc.Shapes Call GetText(myShape, newDoc) Next Set actDoc = Nothing Set newDoc = Nothing End Sub Private Sub GetText(aShape As Shape, myDoc As Document) Dim i As Integer Dim iMax As Integer Select Case aShape.Type 'キャンバスの場合の処理 Case msoCanvas iMax = aShape.CanvasItems.Count For i = 1 To iMax Call GetText(aShape.CanvasItems(i), myDoc) Next i 'グループ化されている場合の処理 Case msoGroup iMax = aShape.GroupItems.Count For i = 1 To iMax Call GetText(aShape.GroupItems(i), myDoc) Next i '上記以外の場合の処理（テキスト抽出） Case Else If aShape.TextFrame.HasText = True Then myDoc.Range.InsertAfter aShape.TextFrame.TextRange.Text End If End Select End Sub