ExcelのShapes内の順番

Excelマクロで、シートにビットマップを貼り付けたあと、そのイメージを取得しようと思い、Shapesの末尾のものを取得していた。

VBA

Dim img As Shape
ActiveCell.PasteSpecial
Set img = Shapes(Shapes.Count)
img.Width = ActiveCell.Width

何もないシートの場合、これでも問題なかった。
ただ、シートにコメントが入っていた場合、コメントのWidth値が変更されてしまった。
最後に入れたモノがShapesの最後に入っていると(勝手に)思っていたが、どうもそうではないらしい。

VBA

ActiveCell.PasteSpecial
Debug.Print "Index=" & Shapes.Count & ", Type=" & Shapes(Shapes.Count).Type & ", Name=" & Shapes(Shapes.Count).Name
Debug.Print "Index=" & Shapes.Count - 1 & ", Type=" & Shapes(Shapes.Count - 1).Type & ", Name=" & Shapes(Shapes.Count - 1).Name

結果

Index=3, Type=4, Name=Comment 1
Index=2, Type=13, Name=Picture 1

Type=4はmsoComment
Type=13はmsoPicture
ということで、後から入れた(貼り付けた)ビットマップが、Shapesの末尾に入っておらず、元々あったコメントが末尾にある状態だった。

ちゃんとやるなら

VBA

Dim img As Shape

ActiveCell.PasteSpecial
For Each img In Shapes
    If (img.Name = Selection.Name) Then
        img.Width = ActiveCell.Width
        Exit For
    End If
Next img

というように貼り付けられたもの(まだ貼り付けた画像が選択状態にあるのでSelection.Nameで取れる)の名前と一致するものを探してやるのが正解かな。

2017-07-07 追加
nukie_53さんからコメントをいただいて、もっと簡潔に解決する方法を教えていただきました。

VBA

Dim img As Picture
ActiveCell.PasteSpecial
Set img = Selection
img.Width = ActiveCell.Width

そもそも欲しいのは貼り付けた画像なので、Shapeで受けずにPictureで受けてWidthを変更しています。
画像などはShapeで処理するものだとばかり思っていましたが、こういうやり方もあるんですね。

VBAはなかなか奥が深い。

2017-07-07 追記その2
PictureからShapeも簡単に取得できたので追記します。

VBA

Dim img As Shape
Dim pic As Picture
ActiveCell.PasteSpecial
Set pic = Selection

Set img = Shapes(pic.Index)

img.LockAspectRatio = msoFalse
img.Placement = xlMoveAndSize
img.Width = ActiveCell.Width
img.Height = ActiveCell.Height

PictureのIndexがShapes内のIndexを指しているようなので、上記のようにするとShapeもうまく取得できました。