ppt2010如何用vba批量修改字体和段落

iizu

从网上找了一段代码，运行时总是出错（删除了on error resume next,不删也没效果）
就是set otextrange那一句，大家帮忙看看怎么修改

批量修改字体：

Sub OED01() '批量修改字体格式、大小和颜色
Dim oShape As Shape
Dim oSlide As Slide
Dim oTxtRange As TextRange
On Error Resume Next
For Each oSlide In ActivePresentation.Slides
   For Each oShape In oSlide.Shapes
          Set oTxtRange = oShape.TextFrame.TextRange　这一句出错，执行不了

          If Not IsNull(oTxtRange) Then
         With oTxtRange.Font
             .Name = "楷体_GB2312"       '改成你需要的字体
             .Size = 20       '改成你需要的文字大小
             .Color.RGB = RGB(Red:=255, Green:=0, Blue:=0) '改成你想要的文字颜色
          End With
          End If
   Next
   Next
End Sub

——————————————————————————————

Sub ParagraphFormat() '批量修改段落格式

Dim oShape As Shape
Dim oSlide As Slide
Dim oTxtRange As TextRange
On Error Resume Next
For Each oSlide In ActivePresentation.Slides
   For Each oShape In oSlide.Shapes
          Set oTxtRange = oShape.TextFrame.TextRange　这一句出错，执行不了
          If Not IsNull(oTxtRange) Then        '此处之前都是设置如何在所有ppt间循环，需特别注意 oTxtRange
         With oTxtRange.ParagraphFormat      '此处开始用所需特定语句替换，一开始会是ActiveWindow.Selection.TextRange.ParagraphFormat，需要用oTxtRange替换前面的部分
        .LineRuleWithin = msoTrue
        .SpaceWithin = 3.25
        .LineRuleBefore = msoTrue
        .SpaceBefore = 0.2
        .LineRuleAfter = msoFalse
        .SpaceAfter = 0
    End With
          End If
   Next
   Next

End Sub

iizu

顶一下，ppt用vba的人看来真是少啊！

11ww22

哥们你已经超越前人走在前头了

御神

可以的

weiyingde

是不是Set oTxtRange = oShape.TextFrame.TextRange　这一句出错，执行不了
注释之前少了英文“'’”?
我把它改为：
Set oTxtRange = oShape.TextFrame.TextRange　'这一句出错，执行不了
运行没有问题。