VBA 插入图片到指定单元格并保存图片为图片文件

\'Upload File to the specific folder
Sub UploadImages(s$, c$)
\'s$      Buttom number
\'c$      Specify a location to show image
\'souf$   The local path of the image file
\'des$    The dest path of the image file
\'dt$     Get date for Named file

Dim fso As Object, souf$, des$
Dim fn As String
Dim n As Integer
On Error Resume Next
Set fso = CreateObject("Scripting.FilesyStemObject")
souf = Application.GetOpenFilename("All image files  (*.jpg,.png,.bmp,.gif),*.jpg,.png,.bmp,.gif")

dt = Format(Now, "yyyymmdd")
des = "D:\2\VBA\A3\Images\" & dt & "-" & s & ".jpg"
fso.CopyFile souf, des \'Copy file from the path Souf$ to des$
MsgBox "Upload Success!"
Set fso = Nothing
Call ShowImages(des, c)
End Sub
\'show images
Sub ShowImages(fn$, val$)
 
 \'fn$            The save path after uploaded
 \'val$           Specify a location to show image ,the value of this variable from UploadImages function


    Dim oSP
    Dim oWK As Worksheet
    Dim sPath As String
    sPath = fn
    Set oWK = ActiveSheet
    \'Insert Image
    Set oSP = oWK.Shapes.AddPicture(fn, msoCTrue, msoCTrue, 1, 1, 100, 100)
    \'Resize Image
    With oSP
        
        .ScaleHeight 1, msoCTrue, msoScaleFromTopLeft
        .ScaleWidth 1, msoCTrue, msoScaleFromTopLeft
    End With
    
    \'Fill image to cell
    With oSP
        .Left = oWK.Range(val).Left
        .Top = oWK.Range(val).Top
        .Height = oWK.Range(val).Height
        .Width = oWK.Range(val).Width
    End With
    
End Sub
 
\'Buttons for upload image
Sub subm1()
 
    Call UploadImages("1", "L18:P23")
End Sub
Sub subm2()
  
    Call UploadImages("2", "L25:P30")
End Sub
Sub subm3()
 
    Call UploadImages("3", "Q25:V30")
End Sub
Sub subm4()
 
    Call UploadImages("4", "L41:P47")
End Sub
Sub Subm5()
    
    Call UploadImages("5", "L49:P55")
End Sub
Sub Subm6()
    
    Call UploadImages("6", "Q49:V55")
End Sub
Sub subm7()
    
    Call UploadImages("7", "X31:AC35")
End Sub
Sub subm8()
  
    Call UploadImages("8", "X37:AC40")
End Sub
Sub subm9()

Call UploadImages("9", "AD37:AH40")
End Sub