时间戳

首页 > 解决方案 > 如何创建 Outlook 电子邮件并调整所有图像的大小

excel - 如何创建 Outlook 电子邮件并调整所有图像的大小

问题描述

下面的 Excel 宏效果很好，除了粘贴到正文中的 Excel 范围内的图像会调整大小（其中大部分为 55%）。

我不知道出了什么问题。

如果我手动复制完全相同的范围并将其粘贴到电子邮件中，图像将保持不变。

Sub mailpaste()


Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim xlSheet As Worksheet
Dim wdDoc As Object
Dim oRng As Object
Dim rngTo As Range
Dim rngSubject As Range

    Application.Range("Report").copy

    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    With ActiveSheet
    Set rngTo = .Range("AA12")
    Set rngSubject = .Range("AA15")
    End With

    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .BodyFormat = 2
        .To = rngTo.Value
        .CC = ""
        .BCC = ""
        .Subject = rngSubject.Value
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.collapse 1
        oRng.Paste
        .Display
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing


End Sub

标签： excelvbaimageoutlookresize

解决方案

您已经在使用 Word 对象，因此请使用内联形状的 InlineShapes 属性高度/宽度

例子

    Set OutMail = OutApp.CreateItem(0)
    Set wdDoc = OutMail.GetInspector.WordEditor

    With OutMail
        .BodyFormat = 2
        .To = rngTo.Value
        .CC = ""
        .BCC = ""
        .Subject = rngSubject.Value
        .Display

         wdDoc.Range.PasteAndFormat Type:=wdChartPicture

         With wdDoc
            .InlineShapes(1).Height = 130
            .InlineShapes(1).Width = 130
         End With


    End With

推荐阅读