Office関連

SmartArtからテキストを取得するPowerPointマクロ

Twitterで@terrysaitoさんが下記のようなツイートをされていました。

そういえばマクロでSmartArtを意識して取り扱ったことなかったなー、と思い、良い機会なのでコードを書いてみることにしました。

Public Sub Sample1()
  Dim shp As PowerPoint.Shape
  Dim s As PowerPoint.Shape
  
  'スライド1の図形を順次処理
  For Each shp In Application.ActivePresentation.Slides(1).Shapes
    'SmartArtのみ処理
    If shp.Type = msoSmartArt Then
      If shp.GroupItems.Count > 0 Then
        For Each s In shp.GroupItems
          If s.HasTextFrame = True Then
            If s.TextFrame2.HasText = True Then
              Debug.Print s.TextFrame2.TextRange.Text
            End If
          End If
        Next
      End If
    End If
  Next
End Sub

まずはShapeオブジェクトのTypeプロパティでSmartArtかどうかを判別し、グループ内の図形を取得するGroupItemsプロパティを使って順番にテキストを取得するコードです。
下図のスライドに対しコードを実行すると、

VBA_SmartArt_01

下図のような結果になります。
図中にある矢印内のテキストも取得しています。

VBA_SmartArt_02

今度はHasSmartArtプロパティでSmartArtかどうかを判別し、SmartArtNodeオブジェクトから順番にテキストを取得するコードです。

Public Sub Sample2()
  Dim shp As PowerPoint.Shape
  Dim n As Office.SmartArtNode
  
  'スライド1の図形を順次処理
  For Each shp In Application.ActivePresentation.Slides(1).Shapes
    'SmartArtのみ処理
    If shp.HasSmartArt = True Then
      For Each n In shp.SmartArt.AllNodes
        If n.TextFrame2.HasText = True Then
          Debug.Print n.TextFrame2.TextRange.Text
        End If
      Next
    End If
  Next
End Sub

結果は下図の通りで、こちらは図中の矢印のテキストを取得できていません。
矢印はノードに含まれていないようです。

VBA_SmartArt_03

この結果からすると、テキストを取得する際はGroupItemsプロパティ(GroupShapesオブジェクト)を使った方が漏れが無さそうです。

ただし、ノードを追加したりレイアウトを変更したりするときは、専用のプロパティやメソッドが用意されたSmartArtオブジェクトを使った方が良いでしょう。
(SmartArtかどうかは、ShapeオブジェクトのTypeプロパティとHasSmartArtプロパティのどちらでも判別できるようです。)

以上、SmartArtからテキストを取得するマクロの紹介でした。

2015/7/8 追記:

@terrysaitoさんから下記返信がありました。

このツイートからすると引っ掛かっているのはグループ化されている図形でしょうか?
この際SmartArtかどうか無視して再帰的に処理するマクロも考えてみました。

Option Explicit

Public Sub Sample()
  Dim shp As PowerPoint.Shape
  
  For Each shp In Application.ActivePresentation.Slides(1).Shapes
    ListShape shp
  Next
End Sub

Private Sub ListShape(ByVal TargetShape As PowerPoint.Shape)
  Dim gshps As PowerPoint.GroupShapes
  Dim shp As PowerPoint.Shape
  
  On Error Resume Next
  Set gshps = TargetShape.GroupItems
  On Error GoTo 0
  If Not gshps Is Nothing Then
    If gshps.Count > 0 Then
      For Each shp In gshps
        ListShape shp
        DoEvents
      Next
    End If
  End If
  
  If TargetShape.HasTextFrame = True Then
    If TargetShape.TextFrame2.HasText = True Then
      GetShapeText TargetShape
    End If
  End If
End Sub

Private Sub GetShapeText(ByVal TargetShape As PowerPoint.Shape)
  Debug.Print TargetShape.TextFrame2.TextRange.Text
End Sub

あとは、数年前に「各スライドに配置されたオートシェイプからテキストを取得するPowerPointマクロ」も書いたことがあるので、そちらが参考になるのかもしれません。

2015/7/8 追記2:

@terrysaitoさんのツイートによると、やっぱり上手くいかないとのこと。

私にも理由が分からなかったのですが、検索したらヒントがありました。

・How to access textrange members inside SmartArt
https://groups.google.com/d/topic/microsoft.public.powerpoint/zkg4d5Ioh5A/discussion

for (int i=1;i<=textRange.Count;i++) { TextRange ranger=textRange._item(1); ....... }

“TextRange(TextRange2)オブジェクトってコレクションだったのか!?”と。

であれば、For Eachでループさせれば上手くいくかもしれません。
(私の方では問題環境が再現できなかったので未確認です。)

Option Explicit

Public Sub Sample()
  Dim shp As PowerPoint.Shape
  
  For Each shp In Application.ActivePresentation.Slides(1).Shapes
    ListShape shp
  Next
End Sub

Private Sub ListShape(ByVal TargetShape As PowerPoint.Shape)
  Dim gshps As PowerPoint.GroupShapes
  Dim shp As PowerPoint.Shape
  Dim trng As Office.TextRange2
  
  On Error Resume Next
  Set gshps = TargetShape.GroupItems
  On Error GoTo 0
  If Not gshps Is Nothing Then
    If gshps.Count > 0 Then
      For Each shp In gshps
        ListShape shp
        DoEvents
      Next
    End If
  End If
  
  If TargetShape.HasTextFrame = True Then
    If TargetShape.TextFrame2.HasText = True Then
      For Each trng In TargetShape.TextFrame2.TextRange
        GetTextRangeText trng
      Next
    End If
  End If
End Sub

Private Sub GetTextRangeText(ByVal TargetTextRange As Office.TextRange2)
  Debug.Print TargetTextRange.Text
End Sub

関連記事

  1. Excel

    PDFを他のファイル形式に変換するVBAマクロ

    「PDF 変換 Word VBA」といったキーワード検索でのアクセスが…

  2. Office関連

    コマンドマクロ一覧(Word 2013 Customer Preview)

    Word 2013 CP版に組み込まれている「コマンドマクロ」のコマン…

  3. Office関連

    選択範囲内で文字列検索を行うWordマクロ

    今日は選択範囲内で文字列検索を行うWordマクロについて考えてみます。…

  4. Excel

    Gmail APIを使ってメール送信するVBAマクロ

    「「Gmail API」β版公開、連動アプリ開発を支援」にもあるように…

  5. Office関連

    テンプレートから簡単に新規文書を作成できるようにするWordテンプレート

    Wordで自作のテンプレートを利用して文書を作成するとき、2007以降…

  6. Office関連

    テキストボックスの中にある表を操作するWordマクロ

    Yahoo!知恵袋で、「Wordマクロでテキストボックスの中にある表の…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP