excel 図形に入れたテキストやテキストボックスの文字をセルに書き出す

excelで図形に入れたテキストの文字やテキストボックスに入れた文字を
セルに書き出したいです。

https://oshiete.goo.ne.jp/qa/6805214.html
のベストアンサーにある「これより下～これより上」のVBAを使って試しましたが、
新しいシートに出力されたのは"コメント"でした。

視覚的に見易いようなフローがあるのですが、システム化するにあたり
セルに直接入力されたものが必要になりました。

VBAは初心者です。
宜しくお願いいたします。

質問者からの補足コメント

• 

  tom04様　早速のご回答をありがとうございました！
  逆のコト・・・ではなく、先頭でご回答いただいたVBAが知りたい内容でした。
  
  上手く出力できたのですが、違うsheet（新規sheet）に書き出されると助かります！
  頂いた見本では、Ａ列に出力され、元々入力があったものに上書きされてしまいました。
  自力でVBAを修正できずお恥ずかしい話ですが、作成していただけると助かりますm(v v)m
  
  宜しくお願いします♪

    補足日時：2018/05/22 08:53

No.2 ベストアンサー 回答者： tom04 回答日時： 2018/05/22 10:34

No.1です。

＞違うsheet（新規sheet）に書き出されると助かります！

Sheetを追加し、そのシートのA列1行目から表示するようにしてみました。
尚、表示するのは「Sheet1」のテキストボックス（オートシェイプ）のテキストとします。
標準モジュールにしてください。

Sub Sample2()
Dim cnt As Long, mySp As Shape
Dim wS As Worksheet
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wS = Worksheets(Worksheets.Count)
With Worksheets("Sheet1")
For Each mySp In .Shapes
If Len(mySp.TextFrame.Characters.Text) > 0 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = mySp.TextFrame.Characters.Text
End If
Next mySp
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

感動～！！！
ありがとうございました。
"Sheet1"の部分を対象のシート名にすればいいんですねっ。
たくさん使わせていただきます。

お礼日時：2018/05/22 10:56

No.1 回答者： tom04 回答日時： 2018/05/21 20:33

こんばんは！

VBAでの一例です。
↓の画像ではオートシェイプのテキストボックス・四角形・楕円（四角形・楕円は「テキストの編集」でテキストを入力しています。

Sub Sample1()
Dim mySp As Shape, cnt As Long
For Each mySp In ActiveSheet.Shapes
If Len(mySp.TextFrame.Characters.Text) > 0 Then
cnt = cnt + 1
Cells(cnt, "A") = mySp.TextFrame.Characters.Text
End If
Next mySp
End Sub

これでA列1行目から各オートシェイプに文字列があればその文字列が表示されます。

ただ質問文を読むと・・・
もしかして逆のコトをやりたいのでしょうか？
（セルに入力された文字列をオートシェイプに表示したい！）

その場合は簡単です。
↓の画像のようにA1～A3セルをそれぞれのオートシェイプにテキストとして表示したい！という場合は

まず最初のオートシェイプをアクティブにします。仮にA1セルの文字列を表示したい場合は
数式バー内に
=A1
とするだけです。

他のオートシェイプも同様に
オートシェイプ選択後　→　数式バー内に
=A2
とか
=A3
のように表示したいセルのセル番地を入れるだけです。m(_ _)m