ExcelのVBAで画像読込→サイズ変更がしたい。

質問

Excel2003を利用して仕事の工事写真帳を作成していますがVBAでどうしても上手くいかない部分があるので教えていただければと思い投稿しました。
【仕様】工事写真帳は1シート構成、用紙1枚に3枚画像が入り、画像の右側には摘要欄があります。画像を読み込む位置をダブルクリックするとセルのサイズ（写真サイズに結合してあります）を取得して画像サイズを変更して格納します。
【問題点】2枚以上画像を読み込んだ状態で実行すると目的の画像のサイズが変更にならない場合があります。
画像を削除したことで画像の名前が重複するのが原因だというところまではわかるのですが対処方法がわかりません。アドバイスをお願いします。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

gyo = ActiveCell.Row '画像読込位置の取得
Set scel = Cells(gyo, 3)

scel.Select 'セルサイズの取得
w = Selection.Width
h = Selection.Height

fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像ファイルを指定して下さい") '画像読込
If fname = False Then
Exit Sub
End If
ActiveSheet.Pictures.Insert(fname).Select
i% = Selection.Index

Selection.Name = "gazou" & i '画像に名前をつける
Set 画像 = ActiveSheet.Shapes("gazou" & i)

With 画像 '画像のサイズ変更
.LockAspectRatio = False
.Placement = xlFreeFloating
.Placement = xlMove
.Width = w
.Height = h
End With

Range("F" & gyo).Select '摘要欄へ移動

End Sub

回答No.1

zap35 · ベストアンサー

画像にわざわざ名前をつける必要はあるのでしょうか？
（以下は一部抜粋して、少しだけ手を入れました）

Dim pict As String
　ActiveSheet.Pictures.Insert(fname).Select
　pict = Selection.Name
　With ActiveSheet.Shapes(pict) '画像のサイズ変更
　　.LockAspectRatio = False
　　.Placement = xlFreeFloating
　　.Placement = xlMove
　　.Width = w
　　.Height = h
　End With

これなら画像を繰り返し削除しても大丈夫に思います

お礼

回答ありがとうございます。

早速直して実行してみたところ、上手くいきました。
本を1冊購入して一通り目を通しましたが、実務では
ネットで同じような例題を探して利用している状況なので
不要なコードを使用していることが多々ありそうです。

これでやっと実用化ができます。ありがとうございました！