VBA 図形内文字列検索

Question

前提・実現したいこと

VBAマクロにおいて
エクセルファイルにおける、図形内の文字列検索メソッドを作成しています。
このコード自体はネットから拾ってきたものにはなります。
どこをどのように修正すべきかご教授願います。

発生している問題・エラーメッセージ

text = parentShape.DrawingObject.Characters.textにおいて、
実行時エラー　'438'
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
とでる。

該当のソースコード

Option Explicit

Sub SearchInAutoShape()
    ' 入力ファイル
    Dim inputfile As String
    inputfile = "C:\work\sample.xlsx"
   
    ' 検索キーワード
    Dim keyword As String
    keyword = "修正"
   
    ' ファイルオープン
    Application.ScreenUpdating = False
    Dim inputBook As Workbook
    Set inputBook = Workbooks.Open(inputfile, ReadOnly:=True)
   
    ' シート数分繰り返し
    Dim i As Long
    For i = 1 To inputBook.Worksheets.Count
       
        ' シートに貼り付けられているオートシェイプ分繰り返す
        Dim parentShape As Shape
        For Each parentShape In inputBook.Worksheets(i).Shapes
            Dim text As String
           
            ' オートシェイプがグループ化されている場合、
            ' グループ化されているオートシェイプのテキストをチェック
            If parentShape.Type = msoGroup Then
                Dim groupedShape As Shape
                For Each groupedShape In parentShape.GroupItems
                    text = groupedShape.TextFrame.Characters.text
                    If InStr(text, keyword) > 0 Then
                        Debug.Print ("sheet : " + inputBook.Worksheets(i).Name)
                        Debug.Print ("text : " + text)
                    End If
                Next groupedShape
               
            ' オートシェイプがグループ化されていない場合
            ' そのオートシェイプのテキストをチェック
            Else
                text = parentShape.DrawingObject.Characters.text
                If InStr(text, keyword) > 0 Then
                    Debug.Print ("sheet : " + inputBook.Worksheets(i).Name)
                    Debug.Print ("text : " + text)
                End If
            End If
        Next parentShape
    Next i
   
    ' ファイルクローズ
    inputBook.Close SaveChanges:=True
    Set inputBook = Nothing
    Application.ScreenUpdating = True
   
End Sub

試したこと

デバックをし、1行ずつ実行はしてみても、同様のエラーが出てしまい、進むことが出来ません。
また、エラー内容を検索しても、誤字脱字等が原因、と検索結果で出てきて
一通り確認はしたのですが誤字脱字は見つかりませんでした。

補足情報（FW/ツールのバージョンなど）

VBAツールを学び始めたものです。
基礎知識は学び、まずはトレースから初めて実行しております。
お手数をおかけしますがお願いいたします。
EXCEL2010,2016　の両環境で実施しました。
※キーワードとパスについては実際の私の環境で適したものを
指定して実行しています。

Answer 1

私も、昨年ネットで調べたことがありましたので、URL記載します
「インストラクターのネタ帳」様のです
https://www.relief.jp/docs/excel-vba-shape-hastext.html

このままのコードだと、下図のようなエラー表示

グループ化解除すると下図のように文字　取得できました

参考までにコード記載します。

コード
```Sub Shape内の文字列を取得する_TextFrame2()
  Dim shp As Shape
 'シート内の図形全てクリックした（グループ化解除）状態
 ActiveSheet.Shapes.SelectAll

  For Each shp In ActiveSheet.Shapes
    If shp.TextFrame2.HasText Then
      MsgBox shp.TextFrame2.TextRange.Text
    End If
  Next shp
     Range("A1").Select ' 再グループ化???

End Sub

Answer 2

確か、直線矢印とかがあるとそうなるはず。
textを取得する前に Debug.Print parentShape.Name, parentShape.Type とか入れて確認してみては？
丁寧にやるなら、Select Case parentShape.Type で分岐。
乱暴にやるなら、On Error Resume Next で突き進む手もある。

Select Case parentShape.Type
Case msoGroup '6
    '
    '
    '
Case msoAutoShape '1
    If parentShape.TextFrame2.HasText Then
        text = parentShape.DrawingObject.Characters.text
    End If

Case msoTextBox '17
    '
    '
Case msoComment '4
    '
    '
Case msoLine '9
    '
    '

Case Else

End Select

Comments

[kty_kk]

仰る通り、矢印があるExcelファイルを対象に行うとこのエラーが起きました。
Debug.Print parentShape.Name,parentShape.Type
でをtext取得する直前に挿入して実行してみたところ、エラーを確認し、
Typeプロパティで取得した定数が"1"で、原因がわかりませんでした。
どのように解消できますでしょうか。

[jinoji]

回答に追記しました。
基本は ParentShape.TextFrame2.HasText で判断したいですが、
Typeによってはそれ自体がエラーになるものがあるみたいなので、
パターンによって処理を書き分ける感じで考えてみました。
すみませんが私もすべてのパターンを押さえているわけではないので
ご自身の環境でエラーが出たらパターンを増やす感じで徐々に対応する形で・・・

[kty_kk]

ご返信遅くなってしまい申し訳ございません。解決することが出来ました。
ありがとうございます！