如何调整Outlook邮件中通过VBA粘贴的图片大小？

你可以通过捕获粘贴到Word编辑器中的图片对象，直接设置其高度和宽度属性来解决这个问题。以下是修改后的代码及关键说明：

关键修改点 #

• 粘贴图片后，获取刚插入的InlineShape对象（通过WordEditor粘贴的位图默认是嵌入式形状）
• 直接为该对象设置Height和Width属性（单位为磅，1厘米≈28.35磅）
• 若未引用Microsoft Word对象库，需手动定义常量wdPasteBitmap，避免编译错误

修改后的完整代码 #

Sub SendEmail()
    ' 定义常量（未引用Word库时需添加）
    Const wdPasteBitmap As Integer = 0
    
    ' 打开新邮件项
    Dim outlookApp As Object
    Dim OutMail As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set OutMail = outlookApp.CreateItem(0) ' olMailItem=0
    
    With OutMail
        .To = ""
        .Subject = "** Please confirm Timesheet by 10:30AM **"
        .Importance = 2 ' olImportanceHigh=2
        .Display
    End With

    ' 获取Word编辑器
    Dim wordDoc As Object
    Set wordDoc = OutMail.GetInspector.WordEditor

    ' 粘贴为图片并调整尺寸
    rng.Copy
    wordDoc.Range.PasteSpecial , , , , wdPasteBitmap
    
    ' 获取刚粘贴的图片对象并设置尺寸
    Dim pastedPic As Object
    Set pastedPic = wordDoc.InlineShapes(wordDoc.InlineShapes.Count)
    pastedPic.Height = 141.75 ' 对应5厘米（1cm≈28.35磅）
    pastedPic.Width = 226.8 ' 对应8厘米

    ' 添加前置HTML内容
    OutMail.HTMLBody = "Timesheets Submitted by " & "Marco" & "<br>" & OutMail.HTMLBody
End Sub

补充说明 #

• 如果需要图片为浮动式而非嵌入式，可将InlineShapes改为Shapes，但需调整粘贴方式或后续转换对象类型
• 若要保持图片比例，只需设置其中一个维度，另一个维度会自动按比例缩放（比如仅设置Width，Height会同步调整）

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