複数の図形にテキストを流し込むExcelマクロ

これは

Excelで資料を作成するときに便利かもしれない、ちょっとしたマクロです。

何かを図解する資料を作ろうとしたとき、
図形を挿入して、右クリックで「テキストの編集」を選んで、、、
というのを繰り返すのが煩わしくなったのです。

そこで、先に図形だけ配置しておいて、
テキストは後からマクロで一気に流し込むことにしました。

以前作った図形の位置調整マクロ を応用する形で作りました。
そちらと併用するとより便利かもしれません。
資料を作るときだけでなく、あとで修正したりするときにも重宝します。

動作のイメージ

1. 図形を選択した状態でマクロを実行します。
   

2. 流し込む文字列をセル範囲で指定します。
   

3. こうなります。
   

コード

Sub 図形に文字列を流し込む()
    On Error Resume Next
    Dim shp As ShapeRange, rng As Range
    With ActiveWindow
        Set shp = .Selection.ShapeRange
        If shp Is Nothing Then If MsgBox("図形を選択した状態で実行してください") = vbOK Then Exit Sub
        Set rng = Application.InputBox("流し込む文字列を指定", "セル範囲選択", .RangeSelection.Address, , , , , 8)
        If rng Is Nothing Then Exit Sub
    End With
    Dim c As Range, i
    For Each c In rng
        i = i + 1
        If i > shp.Count Then Exit Sub
        shp(i).TextFrame.Characters.Text = c.Value
    Next
End Sub