ExcelでVBAを利用してオートシェイプ情報取得

質問

Excelのオートシェイプをテキストデータに変化するVBAを作成したいです
ただし対象となるオートシェイプは複数のオートシェイプがグループ化された
グループオブジェクトになっています

それら特定のパターンを持つオートシェイプオブジェクトの一群があり
1つ1つには想定される名称が存在します

具体的な操作としては複数のオートシェイプオブジェクトを横に並べたイメージダイアグラムを
作成し、それらにそって対応するテキストを配置していきたいというものです

このようなオートシェイプの情報をうまく拾う方法、テキストデータと紐づける方法はありませんでしょうか
よろしくお願いいたします

回答No.1

nishi6 · ベストアンサー

質問の意味をとらえきれていないかと思いますが参考にしてください。

まず、表題の「ExcelでVBAを利用してオートシェイプ情報取得」と最初にある「Excelのオートシェイプをテキストデータに変化するVBAを作成したいです」が異なることを言っているように思えます。『情報取得』と『変化』です。「テキストデータに変化する」がどんな意味なのか分からないからかもしれません。テキストデータに「円」と書かれていたら「図形の円」にする？

＞このようなオートシェイプの情報をうまく拾う方法、テキストデータと紐づける方法はありませんでしょうか

これは、
　１．オートシェイプの情報をうまく拾う方法
　２．テキストデータと紐づける方法
の２つでしょうか

「１．オートシェイプの情報をうまく拾う方法」については参考にモジュールを作ってみました。

「２．テキストデータと紐づける方法」については、
　オートシェイプの情報がどのようなものか分からないですが、オートシェイプのテキストをセルを参照する形式にしてみてはどうでしょうか。添付図の場合、「楕円」のテキストは「=A11」で「明日は」になります。オートシェイプのテキストの算式を使った登録は「セル参照」のみで、複雑な計算式は登録できないのでこのようにしています。複雑な内容を登録したい場合はセル側で整形したりしています。

登録内容を変えたいときはセルの内容を変更します。

＞Excelのオートシェイプをテキストデータに変化するVBAを作成したいです。ただし対象となるオートシェイプは複数のオートシェイプがグループ化されたグループオブジェクトになっています
　「テキストデータに変化する」がどんな意味なのか分かりませんが、「オートシェイプの情報をうまく拾う方法」として、グループ化された複数のオートシェイプから左から順にテキストを取り出して1行目に表示してみました。VBAでテキストを拾ってくる例です。オートシェイプの位置を変えれば再度マクロを実行すれば出力が変わります。

＞具体的な操作としては複数のオートシェイプオブジェクトを横に並べたイメージダイアグラムを作成し、それらにそって対応するテキストを配置していきたいというものです
　この説明から、先にグループ化された複数のオートシェイプ（テキスト入力済み）があり、そのテキストを順に表示するのかなと考えた次第です。

「シートのコードウィンドウ」
グループ化されたオートシェイプを選択して実行します。

添付図にはコマンドボタンがありますが、ボタンから実行する場合は、コマンドボタンの「TakeFocuusOnClick」プロパティを「False」にしてください。

Sub オートシェイプのテキスト出力()
　　Dim shp As Shape 'オートシェイプ
　　Dim i As Integer, j As Integer 'カウンタ
　　Dim n As Integer　　'オートシェイプの個数
　　Dim potLeft() As Single 'オートシェイプの左位置
　　Dim Sort() As Integer　　'オートシェイプの左位置の順

　　On Error GoTo ErrorTrp

　　With Selection.ShapeRange
　　　　If .Type = msoGroup Then 'グループ化されていたら
　　　　　　n = .GroupItems.Count
　　　　　　ReDim potLeft(n), Sort(n)

　　　　　　For i = 1 To n
　　　　　　　　potLeft(i) = .GroupItems(i).Left
　　　　　　　　Sort(i) = 1
　　　　　　　　For j = 1 To i - 1 '左位置を取り込んでソート
　　　　　　　　　　If potLeft(j) >= potLeft(i) Then
　　　　　　　　　　　　Sort(j) = Sort(j) + 1
　　　　　　　　　　Else
　　　　　　　　　　　　Sort(i) = Sort(i) + 1
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Next
　　　　End If

　　　　For i = 1 To n
　　　　　　For j = 1 To n　　'ソート順に出力する
　　　　　　　　If Sort(j) = i Then
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　　　'1行目に順に出力
　　　　　　Cells(1, i) = .GroupItems(j).DrawingObject.Characters.Text
　　　　Next
　　End With

　　Exit Sub
ErrorTrp:

End Sub

お礼

丁寧な回答ありがとうございます

私がやりたかったことをほとんど実装していただけた感じで大変参考になりました
テキストとの紐付けの箇所については、名前の定義を利用して、名前とテキストを
リスト化して利用しました

返事が遅れてしまい申し訳ありません
ありがとうございます