时间戳

首页 > 解决方案 > Excel 范围粘贴在电子邮件正文的中心

excel - Excel 范围粘贴在电子邮件正文的中心

问题描述

使用以下编码，我可以在带有签名的 Outlook 电子邮件中复制范围和过去。一切正常。我唯一想做的就是反映电子邮件正文中心的范围。请协助我如何在电子邮件正文的中心反映数据。

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Set rng = Nothing
Set rng = ThisWorkbook.Sheets("Output").Range("D7:E18")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .To = ""
    .BCC = ""
    .Subject = "Subject"
    .Display
    Dim wdDoc As Object
    Dim wdRange As Object
    Set wdDoc = OutMail.GetInspector.WordEditor
    Set wdRange = wdDoc.Range(0, 0)
    wdRange.InsertAfter vbCrLf & vbCrLf
    rng.Copy
    wdRange.Paste
  Set OutMail = Nothing
Set OutApp = Nothing
End With

标签： excelvba

解决方案

代码的作用是，它不仅将文本居中，而且将粘贴在 Outlook 正文中的表格（Excel 范围）居中。

Option Explicit

Const wdAlignRowCenter As Integer = 1
Const wdAlignParagraphCenter As Integer = 1

Sub Sample()
    Dim OutApp As Object, OutMail As Object
    Dim wdDoc As Object, wdRange As Object
    Dim rng As Range
    Dim i As Long
    
    Set rng = ThisWorkbook.Sheets("Output").Range("D7:E18")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = ""
        .BCC = ""
        .Subject = "Subject"
        .Display
    
        Set wdDoc = .GetInspector.WordEditor
        Set wdRange = wdDoc.Range(0, 0)
        
        wdRange.InsertAfter vbCrLf & vbCrLf
        rng.Copy
        wdRange.Paste
        
        DoEvents
    
        Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
    
        wdRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
        
        For i = 1 To wdRange.Tables.Count
            wdRange.Tables(i).Rows.Alignment = wdAlignRowCenter
        Next i
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

注意：

  1. 如果默认编辑器不是 MS Word，顺便说一句Set wdDoc = .GetInspector.WordEditor会给你错误...
  2. 如果您的身体中有图像，那么您可能还需要单独处理它们

推荐阅读