EXCELのVBAで画像ファイルを呼び出し

質問

EXCELのVBAでセルに入力されているファイル名の画像ファイルを呼び出して、
トリミング、縮小→一旦切り取り、メタファイルで貼り付け→セルの真ん中に配置ということを行いたいです。

このようなVBAを組みましたが、bw = .Width でエラーが起こってしまいます。
一旦切り取りして貼り付けするコードを加えたらエラーになりました。

どのようにしたらきちんと希望の形ではりつけることができるでしょうか？

よろしくお願いします。

Sub photocalltest()

'セルの値を取得して画像を貼り付け
'
'
Dim i As Long

For i = 2 To 5
ActiveSheet.Pictures.Insert ("C:\Documents and Settings\temp\" & Cells(7, i).Value & ".jpg")

With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

'トリミング
.PictureFormat.CropBottom = 95
.PictureFormat.CropRight = 57.78
.PictureFormat.CropLeft = 59.28
.PictureFormat.CropTop = 100

'縮小
.Height = 197.25
.Width = 162#

.Cut
'Cells(7, i).Select
ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)"

'貼り付け位置指定
aw = Cells(7, i).Width
bw = .Width //ここでオブジェクトが必要ですエラー
x = (aw - bw) / 2
.Left = Cells(7, i).Left + x
ah = Cells(7, i).Height
bh = .Height
y = (ah - bh) / 2
.Top = Cells(7, i).Top + y

End With
Next i

End Sub

回答No.1

keithin · ベストアンサー

with activesheet.shapes(activesheet.shapes.count)
でそこまで引っ張ってきてたのを.cutしてしまったので，もう「オブジェクトが無くなって」しまってます。

簡単な手直し例：
.Cut
ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)"

end with
with activesheet.shapes(activesheet.shapes.count)

'貼り付け位置指定
aw = Cells(7, i).Width
bw = .Width
　：
以下続く

お礼

回答ありがとうございます。
希望の形で貼り付けることが出来ました。