Excel2007 VBAで画像挿入について

質問

Sub 図形挿入等倍()
Dim FilePath As Variant
FilePath = Application.GetOpenFilename(",*.png")
If Not FilePath = False Then
ActiveSheet.Pictures.Insert(FilePath).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 1#
Selection.ShapeRange.Left = ActiveCell.Left + 2.25
Selection.ShapeRange.Top = ActiveCell.Top + 2.25
End If

With Selection.ShapeRange.Line
.Weight = 2.25 '線の太さを2.25に
.ForeColor.RGB = RGB(255, 0, 0) '赤枠に

End With
End Sub

上記のコードを書き、画像を挿入したときは問題ないのですが
画像を挿入せずにキャンセルすると

実行時エラー438

オブジェクトは、このプロパティまたはメソッドをサポートしていません。とでてしまいます
デバックをしてみると
With Selection.ShapeRange.Lineの部分が黄色くなっているので
ここを修正したらいいと思うのですが
どのように修正したらいいのか分かりません
お分かりの方いましたらご教授お願い致します

回答No.1

keithin · ベストアンサー

今のそのマクロの

If Not FilePath = False Then
　：
End if

の中に、当該のWith .. End Withも繰り込んでしまえばＯＫです。

お礼

ありがとうございます
ご指摘通りに直したら問題ないです
本当にありがとうございまいした
かなり助かりました

回答No.2

watabe007

>画像を挿入せずにキャンセルすると
キャンセルした場合はExit Subしましょう
If FilePath = False Then Exit Sub

Sub 図形挿入等倍()
　　Dim FilePath As Variant

　　FilePath = Application.GetOpenFilename(",*.png")
　　If FilePath = False Then Exit Sub
　　With ActiveSheet.Pictures.Insert(FilePath)
　　　　.ShapeRange.LockAspectRatio = msoTrue
　　　　.ShapeRange.Width = .ShapeRange.Width * 1#
　　　　.ShapeRange.Left = ActiveCell.Left + 2.25
　　　　.ShapeRange.Top = ActiveCell.Top + 2.25
　　　　With .ShapeRange.Line
　　　　　　.Weight = 2.25
　　　　　　.ForeColor.RGB = RGB(255, 0, 0)
　　　　End With
　　End With
End Sub