MS Project VBA生成PPT文本形状激活后偏移，需设置何属性阻止？

问题原因 #

用Application.EditCopy从MS Project复制文本内容粘贴到PPT时，生成的是文本框/表格类结构化形状，这类形状默认带有PowerPoint的自动布局属性：

• 锚点未锁定，激活幻灯片时PowerPoint会重新计算锚点位置
• 文本框默认启用自动调整大小，若内容或幻灯片布局触发重绘，会连带改变位置
• 部分形状可能带有"随文字移动"的关联属性

而用EditCopyPicture粘贴的是静态位图，没有这些动态布局逻辑，所以位置始终稳定。

解决步骤 #

粘贴形状后立即设置以下属性，阻止PowerPoint自动调整位置：

1. 锁定形状锚点 #

设置LockAnchor = True，固定形状在幻灯片上的锚点位置，避免激活时重定位：

Dim pastedShape As Shape
Set pastedShape = myslide.Shapes.Paste(1) ' 获取粘贴的第一个形状
pastedShape.LockAnchor = True

2. 禁用文本自动调整 #

针对带文本的形状，关闭自动调整大小功能，防止文本变动触发形状位移：

If pastedShape.HasTextFrame Then
    ' 禁用自动调整大小
    pastedShape.TextFrame2.AutoSize = msoAutoSizeNone
    ' 可选：关闭自动换行，避免文本换行导致形状尺寸变化
    pastedShape.TextFrame.WordWrap = False
End If

3. 强制设置绝对位置 #

粘贴后重新明确设置形状的绝对坐标，覆盖PowerPoint的自动定位逻辑：

' 示例：根据幻灯片尺寸和用户设置的边距计算位置
Dim slideWidth As Double, slideHeight As Double
slideWidth = myslide.Parent.PageSetup.SlideWidth
slideHeight = myslide.Parent.PageSetup.SlideHeight

' 假设用户设置的边距：leftMargin, topMargin, rightMargin, bottomMargin
pastedShape.Left = leftMargin
pastedShape.Top = topMargin
' 可选：按边距设置形状尺寸，确保缩放符合预期
pastedShape.Width = slideWidth - leftMargin - rightMargin
pastedShape.Height = slideHeight - topMargin - bottomMargin

补充说明 #

• 若粘贴的是表格对象，除上述设置外，可检查Shape.Table的相关属性，确保未启用自动调整表格大小的选项
• 避免依赖PowerPoint的相对对齐布局计算，始终用绝对坐标定义位置，减少自动调整触发的可能

内容的提问来源于stack exchange，提问作者Malcolm.Farrelle