【Excel/VBA】シェイプのテキストを書き換えながら増殖させる

資料を作らねばならない→うおおお、シェイプたくさん作るのめんどうくせぇー！→モジュール作る。

沢山作りたいシェイプの書式を整えてから、それを選択した状態で走らせます。

'-----------------------------------------------------
Public Sub DupShap(Str as String)
'========================================
' 選んだテキスト付シェイプを、渡したテキストの中身で書換えながら増殖
'
' ※渡し値はカンマ区切りで頼む。
'========================================
Dim shps As ShapeRange
Dim shp As Shape
Dim wkAry() As String, i As Long

If TypeName(Selection) = "TextBox" Then

Set shps = Selection.ShapeRange　　　　' シェイプの複数選択のエリア管理
Set shp = shps(1)　　　　　　　　　　　　' こうしないとアクティブなシェイプを拾えないんだ…。
Set shps = Nothing

wkAry = Split(Str, ",")　　　　　
　　　' ※専用ワークシートに貼られているテキスト、みたいな設計にしたいところを時間節約。Splitさんマジクール
　　　 ' 　　　・実際は、渡し値変数ではなく、実値をぶちこんだ。

For i = 0 To UBound(wkAry)

shp.Copy　　　　　　' コピー一回で済むかと思ったが、問屋がおろさなかった…。
shp.Select　　　　　 ' ←これをしないと、シェイプがぴったり重なって貼られるためカオス
ActiveSheet.Paste

　　　　　' コピー貼り付けしたシェイプを選んで、テキストを配列からセット
Set shps = Selection.ShapeRange
Set shp = shps(1)
shp.TextFrame.Characters.Caption = wkAry(i)

Next

Set shp = Nothing
Set shps = Nothing

End If

End Sub
'-----------------------------------------------------
' イミディエイト
'-----------------------------------------------------
call DupShap("先導アイチ,櫂トシキ,葛木カムイ,戸倉ミサキ")
'-----------------------------------------------------