VBAで選択した画像を貼り付けたい

VBAでエクセルファイルに選択した画像を貼り付けたいです。
現在使用しているコードは以下のとおりです。

これをファイル名を指定するのではなく、マクロを実行するとダイヤログが出て
ファイルの選択をして画像を貼り付けるようにしたいのです。
申し訳ありませんがこのコードを手直しして頂けませんでしょうか？
宜しくお願い致します。


Sub 画像貼り付け()
Dim objShape As Object

Set objShape = ActiveSheet.Shapes.AddPicture( _
Filename:="C:\○○○\×××\Desktop\〇〇.bmp", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=130, _
Top:=104, _
Width:=130, _
Height:=150)

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2020/08/25 20:51

こんばんは、

こんな感じかな？

Sub 画像貼り付け()
　　Dim objShape As Object
　　Dim Filename As String
　　With Application.FileDialog(msoFileDialogOpen)
　　　　.Title = "bpmファイルを選択してください。"
　　　　.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop")
　　　　.Filters.Clear
　　　　.Filters.Add "bmpファイル", "*.bpm", 1
　　　　If .Show = True Then
　　　　　　Filename = .SelectedItems(1)
　　　　End If
　　　　If Filename = "" Then Exit Sub
　　End With

　　Set objShape = ActiveSheet.Shapes.AddPicture(Filename, _
　　　　　　LinkToFile:=False, _
　　　　　　SaveWithDocument:=True, _
　　　　　　Left:=130, _
　　　　　　Top:=104, _
　　　　　　Width:=130, _
　　　　　　Height:=150)

この回答へのお礼

ありがとうございます！
お陰様で理想の形になりました。

お礼日時：2020/08/26 12:18

No.2 回答者： Qchan1962 回答日時： 2020/08/25 21:00

ごめんなさい。

　
タイプミス "*.bpm", 1　×　
"*.bmp", 1

ちなみに
.Filters.Add "bmpファイル", "*.bmp", 1
.Filters.Add "画像ファイル", "*.jpg;*.png", 2

のようにフィルタ拡張子を増やす事も出来ます。