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

时间:2016-08-25 16:40:08

标签: excel excel-vba vba

我正在尝试在特定范围内插入图片,我希望以原始尺寸插入图片。

以下代码工作正常,但图像已调整大小:

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

关于评论的任何问题发布!

1 个答案:

答案 0 :(得分:1)

而不是//Call to generate invoice var invoiceAdded = dataService.Add(invoice); //Send Email dataService.SendEmail<Invoice>(invoiceAddded, customer.PrimaryEmailAddr.Address); 使用AddPicture

Pictures.Insert