PPT中批量替换内容
不知PPT中是否可以实现批量替换内容,或通过其他方式也可,以下为举例例:想把PPT文档中所有的"A"替换为“B”,“C”替换为“D","E"替换为“F”....,大概共1000项,请问是否有方法可以实现
感谢 可以的,利用遍历所有幻灯片可以实现。 给个实例吧
Sub 批量替换字符()
Dim sld As Slide, shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Set trng = shp.TextFrame.TextRange
For i = 1 To trng.Characters.Count
With trng.Characters(i)
If .Text = "A" Then
.Text = "B"
.Font.Color = Choose(Int(Rnd * 3 + 1), vbBlue, vbGreen, vbRed, vbYellow)
.Font.Bold = True
End If
If .Text = "C" Then
.Text = "D"
.Font.Color = Choose(Int(Rnd * 3 + 1), vbBlue, vbGreen, vbRed, vbYellow)
End If
If .Text = "E" Then
.Text = "F"
.Font.Color = Choose(Int(Rnd * 3 + 1), vbBlue, vbGreen, vbRed, vbYellow)
.Font.Bold = True
End If
End With
Next
End If
End If
Next
Next
End Sub
若是上千页,上述代码自然不是好的解决方案,下面的代码,是优化的代码,效率高一些,继续提供下载。
Sub 批量替换字符()
arr = Array("A", "C", "E", "G", "I", "K", "M") '被替换的字符
brr = Array("B", "D", "F", "H", "J", "L", "N") '替换后的字符
x = LBound(arr)
Z = UBound(arr)
Dim sld As Slide, shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Set trng = shp.TextFrame.TextRange
For i = x To Z
trng.Replace FindWhat:=arr(i), Replacewhat:=brr(i), WholeWords:=True
Next
End If
End If
Next
Next
End Sub
厉害,学习了!
页:
[1]