Sub ShapeTest() Debug.Print "オートシェイプの数: " & Sheet1.Shapes.Count Dim v As Variant Dim str As String On Error Resume Next For Each v In Sheet1.Shapes Err.Clear str = "" str = v.TextFrame.Characters.Text If str <> "" Then Debug.Print "シェイプのテキスト: " & str & " :テキスト終わり" End If Next v On Error GoTo 0 End Sub一応オートシェイプが0のときも、動きはする。
もう少し効率良い処理を考えないとかな。