标题: ppt2010如何用vba批量修改字体和段落 [打印本页] 作者: 初心若雪_001 时间: 2018-3-13 14:36 标题: ppt2010如何用vba批量修改字体和段落 从网上找了一段代码，运行时总是出错（删除了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