如何使用VBA调整从Excel插入到Outlook邮件的图片尺寸

失效原因 #

尺寸调整不生效的核心问题是操作对象匹配错误：通过PasteAndFormat wdChartPicture方式粘贴到Outlook邮件Word编辑器的图片，默认是嵌入式对象，归属InlineShapes集合，而非浮动图片对应的Shapes集合，调用错误的对象集合自然无法触发尺寸修改。

可调用的对象与方法 #

直接操作InlineShape对象的下述属性即可完成尺寸调整：

• LockAspectRatio：赋值为msoTrue可锁定图片原始宽高比，避免拉伸变形
• Width：设置图片宽度，单位为磅
• Height：设置图片高度，单位为磅，锁定纵横比时只需设置宽/高中一个值，另一个会自动按比例适配

修正后的完整代码 #

Sub SendOutlookMail()
    Dim outlookApplication As Outlook.Application
    Dim mail As Outlook.MailItem
    Dim insp As Outlook.Inspector
    Dim doc As Word.Document
    Dim msgText As String
    Dim pastedImg As Word.InlineShape

    Set outlookApplication = New Outlook.Application

    Set mail = outlookApplication.CreateItem(olMailItem)
    With mail
        .BodyFormat = olFormatRichText
        .Display
        .To = ""
        .CC = ""
        .Subject = "Report " & Date
        Set insp = .GetInspector
        Set doc = insp.WordEditor
        msgText = "Hallo " & vbNewLine
        doc.Range.InsertBefore msgText
                   
        Tabelle2.Range("A1:I32").Copy
        doc.Range(Len(msgText), Len(msgText)).PasteAndFormat wdChartPicture
        
        ' 获取刚粘贴的图片对象
        Set pastedImg = doc.InlineShapes(doc.InlineShapes.Count)
        ' 锁定纵横比避免变形
        pastedImg.LockAspectRatio = msoTrue
        ' 按需求设置宽度值，示例为400磅
        pastedImg.Width = 400
    End With
        
End Sub

注意事项 #

如果后续修改了图片粘贴的环绕方式为非嵌入式，才需要通过doc.Shapes集合获取目标图片对象调整尺寸，当前代码逻辑下必须使用InlineShapes集合才能正确匹配到刚粘贴的图片。

内容的提问来源于stack exchange，提问作者VivekKumar