PowerPoint VBA模拟主页Font Shadow文本阴影效果失败求助

问题背景 #

我从未使用过PowerPoint VBA，制作了一份销售表彰传单：幻灯片1为说明页，幻灯片2为传单页，已创建UserForm用于填充传单数据。当前需要实现与PowerPoint主页选项卡（字体>阴影）一致的文本阴影效果，但尝试多段VBA代码均未成功。传单位于幻灯片2，目标文本所在形状编号为14，怀疑可能是幻灯片/形状编号问题，或是代码逻辑有误。

尝试过的代码 #

Test 1

'Test 1
Sub setTextShadow()
Dim sh As Shape
Set sh = ActivePresentation.Slides(2).Shapes(14)
Dim tr As TextRange2
Set tr = sh.TextFrame2.TextRange
    With tr.Font.Shadow
        .OffsetX = 10
        .OffsetY = 10
        .Size = 1
        .Blur = 4
        .Transparency = 0.5
        .Visible = True
    End With
End Sub

Test 2

和Test 1代码一致，只是把TextRange2替换成TextRange，TextFrame2替换成TextFrame

Test 3

'Test 3, 网上说这样就能模拟阴影效果
Sub setTextShadow()
End Sub
Dim sh As Shape
Set sh = ActivePresentation.Slides(2).Shapes(14)
Dim tr As TextRange
Set tr = sh.TextFrame.TextRange
tr.Font.Shadow = True
    End With
End Sub

（注：这段代码存在语法错误，End Sub提前结束了过程，还有未配对的End With，无法正常运行）

Test 4

'Test 4
Sub MakeShadow5()
Dim sftShadow As ShadowFormat
Set sftShadow = ActivePresentation.Slides(2).Shapes(14).Shadow
End Sub

解决方案 #

1. 先验证形状编号是否正确
   运行这段代码确认目标形状是否为需要设置阴影的文本框：

   Sub CheckShape()
       Dim sh As Shape
       Set sh = ActivePresentation.Slides(2).Shapes(14)
       sh.Select '选中目标形状，直观确认是否正确
   End Sub
   

   如果选中的不是目标文本框，说明形状编号错误，需要重新确认编号。

2. 正确的字体阴影实现代码
   要模拟PowerPoint自带的字体阴影（主页选项卡的Font>Shadow），分两种对象模型实现：

   方法一：旧版对象模型（兼容更多PowerPoint版本）

   Sub SetFontShadow()
       Dim sh As Shape
       Dim tr As TextRange
       
       '定位目标形状
       Set sh = ActivePresentation.Slides(2).Shapes(14)
       '确保形状包含文本框且有内容
       If sh.HasTextFrame = msoTrue And sh.TextFrame.HasText = msoTrue Then
           Set tr = sh.TextFrame.TextRange
           '启用默认字体阴影（和主页选项卡Shadow效果一致）
           tr.Font.Shadow = msoTrue
       End If
   End Sub
   

   方法二：新版对象模型（可自定义精确阴影参数）

   如果需要完全匹配默认阴影的参数（偏移X/Y为2磅、模糊2磅、透明度50%、黑色），用TextRange2设置：

   Sub SetFontShadow2()
       Dim sh As Shape
       Dim tr As TextRange2
       
       Set sh = ActivePresentation.Slides(2).Shapes(14)
       If sh.HasTextFrame = msoTrue And sh.TextFrame.HasText = msoTrue Then
           Set tr = sh.TextFrame2.TextRange
           With tr.Font.Shadow
               .Visible = msoTrue
               .OffsetX = 2 '单位为磅（pt）
               .OffsetY = 2
               .Blur = 2
               .Transparency = 0.5
               .ForeColor.RGB = RGB(0, 0, 0) '黑色阴影
               .Size = 1 '不缩放阴影
           End With
       End If
   End Sub
   

3. 常见错误排查

   • Test 3存在致命语法错误：End Sub提前终止了过程，后续代码完全不会执行，还有多余的End With，直接废弃即可。
   • Test 4仅定义了阴影对象，未设置任何属性，自然看不到效果。
   • 确认目标形状是独立文本框，而非图片、组合形状等，只有文本框才有TextFrame/TextFrame2属性。

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