如何通过VBA实现粘贴到Outlook中的Excel表格居中？

原代码（除居中对齐外其他功能正常）：

'Copy contents
    Sheets("Tables").Select
    Range("J6:R145").Select
    Range("J6").Activate
    Selection.Copy

'Open new mail item
    Dim outlookApp As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set outMail = outlookApp.CreateItem(0)
   
'Get Word editor
    outMail.Display
    Dim wordDoc As Object
    Set wordDoc = outMail.GetInspector.WordEditor
   
'Paste as image
    wordDoc.Range.PasteAndFormat Type:=wdChartPicture
    wordDoc.Range.Select
    Selection.Rows.Alignment = wdAlignRowCenter

当前问题：调试时居中相关步骤执行失败

已尝试以下语句，均无法实现居中：

Selection.PageSetup.CenterHorizontally = True
Selection.HorizontalAlignment = xlCenter
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

同时需要解决：粘贴内容时如何避免删除邮件签名？

解决方案 #

1. 实现粘贴内容居中 #

问题出在选中范围错误，且未针对粘贴的图片对象操作。修改粘贴后的代码部分，直接定位并设置图片的对齐方式：

'Paste as image
    Dim pastedShape As Object
    '粘贴到正文末尾（签名前位置）
    wordDoc.Range(wordDoc.Content.End - 1).PasteAndFormat Type:=wdChartPicture
    '获取刚粘贴的图片对象
    Set pastedShape = wordDoc.Shapes(wordDoc.Shapes.Count)
    '设置为嵌入型，才能应用段落对齐
    pastedShape.WrapFormat.Type = wdWrapInline
    '设置图片居中
    pastedShape.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter

2. 避免粘贴时删除签名 #

默认wordDoc.Range.Paste会覆盖整个正文，只需将粘贴位置定位到签名之前即可。outMail.Display后签名会自动添加到正文末尾，通过wordDoc.Content.End - 1定位到正文最后一个字符的位置粘贴，就不会覆盖签名。

另外建议优化复制代码，避免使用Select和Activate：

'Copy contents（优化版）
    Sheets("Tables").Range("J6:R145").Copy

完整优化代码 #

'定义常量（未引用Word对象库时需要）
Const wdChartPicture = 10
Const wdWrapInline = 0
Const wdAlignParagraphCenter = 1

'Copy contents
    Sheets("Tables").Range("J6:R145").Copy

'Open new mail item
    Dim outlookApp As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set outMail = outlookApp.CreateItem(0)
   
'Get Word editor
    outMail.Display
    Dim wordDoc As Object
    Set wordDoc = outMail.GetInspector.WordEditor
   
'Paste as image without overwriting signature, then center
    Dim pastedShape As Object
    wordDoc.Range(wordDoc.Content.End - 1).PasteAndFormat Type:=wdChartPicture
    Set pastedShape = wordDoc.Shapes(wordDoc.Shapes.Count)
    pastedShape.WrapFormat.Type = wdWrapInline
    pastedShape.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter

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