jfsyb1979 发表于 2017-6-7 09:15:08

PPT中批量替换内容

不知PPT中是否可以实现批量替换内容,或通过其他方式也可,以下为举例
例:想把PPT文档中所有的"A"替换为“B”,“C”替换为“D","E"替换为“F”....,大概共1000项,请问是否有方法可以实现
感谢

afeizhang 发表于 2017-6-7 10:26:00

可以的,利用遍历所有幻灯片可以实现。

lazyland 发表于 2017-6-7 10:47:12

给个实例吧
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

九头鸟 发表于 2017-6-7 11:43:34

若是上千页,上述代码自然不是好的解决方案,下面的代码,是优化的代码,效率高一些,继续提供下载。
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

dudushi 发表于 2017-6-7 11:52:37

厉害,学习了!
页: [1]
查看完整版本: PPT中批量替换内容