在excel vba中将图像添加到原始尺寸的范围

我试图插入一个特定范围的图像,我想要插入其原始尺寸的图像。

下面的代码工作正常,但图像resize:

Sub InsertPictureInRangeAntes(path As String, PictureFileName As String, TargetCells As Range) 'inserts a picture and resizes it to fit the TargetCells range Dim p As Shape, t As Double, l As Double, w As Double, h As Double If dir(path, vbDirectory) = "" Then MsgBox "Doesn't exists an image in this path", vbInformation Exit Sub Else: path = path & PictureFileName End If 'import picture Set p = ActiveSheet.Shapes.AddPicture(Filename:=path, linktofile:=msoFalse, _ savewithdocument:=msoCTrue, Left:=l, Top:=t, Width:=w, Height:=h) 'determine positions With TargetCells t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With 'position picture With p .Top = t .Left = l .Width = w'I dont know how to take the original dimensions .Height = h End With Set p = Nothing End Sub 

任何问题发表评论!

而不是AddPicture使用Pictures.Insert

 Sub addPicture() Dim pct Set pct = Worksheets("Sheet1").Pictures.Insert("H:\My Documents\My Pictures\abc.jpg") '/ Set Top,Left etc if required. pct.Top = 1 pct.Left = 10 End Sub