teleman 发表于 2017-3-2 09:52:36

PPT中批量替换内容


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

rwan_hello 发表于 2017-3-2 11:07:51


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

011070110 发表于 2017-3-2 11:26: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

wendy.dai 发表于 2017-3-2 12:45:16

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

trott90 发表于 2017-3-2 13:07:38


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