HasTextFrameの概要
前回は否定条件について解説しました(前回の記事)。今回は選択したシェイプに文字が書けるかどうかの判定をするHasTextFrameについて記載します。前回の内容の場合、スライド内に矢印や線があると下記内容のエラーが発生します。

HasTextFrameはShapeが持っているオブジェクトで文字が書けるシェイプに対してはtrue(-1)を、そうでないシェイプにはfalse(0)を返します。条件文でHasTextFrameを判定させると検索中に矢印や線などの文字が書けないシェイプに対して処理を行いエラーを回避することができます。前回のコードに実装すると下記になります。
コード
'VBA標準モジュール
Option Explicit
Sub findTest(txt As String)
Dim prs As Presentation 'プレゼンテーション
Dim sld As Slide 'スライド
Dim shp As Shape 'シェイプ
Dim txtRng As TextRange 'テキストレンジ
Dim foundtext As TextRange '文字発見用テキストレンジ
Dim flgFind As Boolean '文字発見フラグ
Dim sldNum As Integer '文字発見字のスライドNo
Dim msg As String 'メッセージ内容
Dim btm As Integer 'ボタン種類
Dim ttl As String 'タイトル
Dim response As Integer 'ボタン押した後の反応
msg = "見つけたよ!!"
btm = 4
ttl = "メッセージ"
flgFind = False
For Each prs In Presentations '全プレゼンテーションをループ
For Each sld In prs.Slides '全スライドをループ
For Each shp In sld.Shapes '全図形をループ
If shp.HasTextFrame Then 'テキストフレーム有り
Set txtRng = shp.TextFrame.TextRange
Set foundtext = txtRng.Find(txt, msoFalse, msoFalse)
'文字を発見した時
If Not (foundtext Is Nothing) Then
flgFind = True '文字発見
With foundtext
sldNum = sld.SlideIndex '検索ワードが記載されたスライドNo代入
prs.Windows(1).Activate '検索ワードがあるプレゼンテーションをアクティブ化
ActiveWindow.View.GotoSlide Index:=sldNum '検索ワードがあるスライドを開く
response = MsgBox(msg, btm, ttl) 'メッセージの返答に対する返り値
'ボタンを押した後の反応
If response = vbYes Then 'YESの場合
shp.Select '検索ワードを含むシェイプを選択
Exit Sub 'FindTestから抜ける
End If
End With
End If
End If
Next
Next
Next
If flgFind = False Then
MsgBox ("ごめんなさい、見つけられませんでした・・・")
Else
MsgBox ("検索終了")
End If
End Sub
ユーザーフォームを実行し、資料内に矢印と線があってもエラーにならなかったと思います。HasTextFrameはグループ化したシェイプ、表(文字が書けるのに何故か文字が書けない判定になる)に対しても有効です。次回はまずグループ化したシェイプからワード検索する方法を解説します。