PPT 批量删除 红色文字

1.首先WPS打开 PPT 中的 VBA 编辑器，

2.无VB编辑器，当前WPS没有安装VB，

网上下载 WPS VB安装包：Visual Basic for Application

VBA 代码如下：

Sub FindAndDeleteTextWithFormat()

    Dim sld As Slide

    Dim shp As Shape

    For Each sld In ActivePresentation.Slides

        For Each shp In sld.Shapes

            If shp.Type = msoGroup Then

               DeleteEmptyTextInGroupShape shp

            ElseIf shp.HasTable Then

                DeleteEmptyTextInTable shp

            ElseIf shp.HasTextFrame And shp.TextFrame.HasText Then

                DeleteEmptyTextInShape shp

           End If

         Next

    Next sld

End Sub

Function DeleteEmptyTextInGroupShape(oSh As Shape)

' Please make sure oSh is a group shape

    Dim oGpSh As Shape

    For Each oGpSh In oSh.GroupItems

        If oGpSh.Type = msoGroup Then

           DeleteEmptyTextInGroupShape oGpSh

        ElseIf oGpSh.HasTable Then

           DeleteEmptyTextInTable oGpSh

        ElseIf oGpSh.HasTextFrame And oGpSh.TextFrame.HasText Then

           DeleteEmptyTextInShape oGpSh

        End If

    Next

End Function

Function DeleteEmptyTextInTable(oSh As Shape)

' Please make sure oSh is a table

    Dim oTabSh As Table

    Dim lRow As Long

    Dim lCol As Long

    If oSh.HasTable Then

       Set oTabSh = oSh.Table

       For lRow = 1 To oTabSh.Rows.Count

           For lCol = 1 To oTabSh.Columns.Count

               DeleteEmptyTextInShape oTabSh.Cell(lRow, lCol).Shape

           Next lCol

       Next lRow

     End If

End Function

Function DeleteEmptyTextInShape(oSh As Shape)

' Please make sure oSh contains text

    If Not (oSh.HasTextFrame And oSh.TextFrame.HasText) Then

       Exit Function

    End If

    Dim i As Long

    With oSh.TextFrame.TextRange

        For i = .Characters.Count To 1 Step -1

             If .Characters(i, 1).Font.Color = vbRed Then

                .Characters(i, 1).Text = ""

            End If

        Next

    End With

End Function