How to set Multiple selection to insert photo in this code

Closed
Charan - Dec 10, 2021 at 11:00 PM
Hello,
Can any one please slove this code. I want to get multiple photos at once. Here my code is supported to pick only single selection while goes to folder option.
But I want multiple selection.
Please, edit my code to get multi selection


Sub Insert()

Dim myPicture As String, MyRange As Range
myPicture = Application.GetOpenFilename _
("Pictures (.bmp; .gif; .jpg; .png; .tif),.bmp; .gif; .jpg; .png; .tif", _
, "Select Picture to Import")

Set MyRange = Selection
InsertAndSizePic MyRange, myPicture
End Sub


Sub InsertAndSizePic(Target As Range, PicPath As String)

Dim p As Picture
Application.ScreenUpdating = False

On Error GoTo EndOfSubroutine:
Set p = ActiveSheet.Pictures.Insert(PicPath)

'resize
Select Case (Target.Width / Target.Height) / (p.Width / p.Height)
Case Is > 1
p.Height = Target.Height * 0.9
Case Else
p.Width = Target.Width * 0.9
End Select

'center picture
p.Top = Target.Top + (Target.Height - p.Height) / 2:
p.Left = Target.Left +(Target.Width - p.Width) / 2 :

Exit Sub

EndOfSubroutine:
End Sub