将所有PPT中的字体颜色白色改成黑色---使用AI提高效率

背景

在工作中，遇到一个PPT，老板需求，将PPT页面的所有的字体从白色改成黑色，

检查了发现，这个ppt有几个问题，没有使用母版，都是每一页进行编写，

一共500多页，

如果每个都改，改死人了，，，，

那么，使用ai来进行处理该情况，

文本颜设置为黑色

找百度提问：

"使用vba写一段代码，将ppt里面所有的页面的字体的颜色设置为黑色"

vbnet 复制代码

Sub SetAllTextToBlack()  
    Dim sld As Slide  
    Dim shp As Shape  
    Dim txtRng As TextRange  
      
    ' 遍历每个幻灯片  
    For Each sld In ActivePresentation.Slides  
        ' 遍历每个形状  
        For Each shp In sld.Shapes  
            ' 检查形状是否包含文本（即，是否为文本框）  
            If shp.HasTextFrame Then  
                If shp.TextFrame.HasText Then  
                    ' 获取文本范围  
                    Set txtRng = shp.TextFrame.TextRange  
                      
                    ' 遍历文本范围中的每个段落（对于简单的文本，这可能只有一个段落）  
                    ' 但对于包含多个段落的文本框，这确保了所有文本都被修改  
                    With txtRng  
                        .Font.Color.RGB = RGB(0, 0, 0) ' 设置颜色为黑色  
                          
                        ' 如果文本框包含多个段落，需要遍历每个段落  
                        Dim i As Long  
                        For i = 1 To .Paragraphs.Count  
                            .Paragraphs(i).Font.Color.RGB = RGB(0, 0, 0) ' 再次设置颜色为黑色（可选，取决于你的具体需求）  
                        Next i  
                    End With  
                End If  
            End If  
        Next shp  
    Next sld  
End Sub

请注意，虽然我在注释中提到了可能需要遍历每个段落，但在许多情况下，如果你只是简单地将整个文本框的文本颜色设置为黑色，那么直接设置TextRange的Font.Color.RGB属性就足够了。然而，如果你的文本框包含多个段落，并且你想要确保每个段落都被单独处理（尽管在这个特定的例子中，它们都将被设置为相同的颜色），那么你可以通过遍历Paragraphs集合来实现这一点。
这段代码将遍历活动演示文稿中的所有幻灯片，查找包含文本的形状，并将这些文本的颜色更改为黑色。请确保在运行此代码之前保存你的工作，以防不测。

实际操作，

打开ppt
Alt +F11
运行代码

表格内字体设置为黑色

发现还有表格的颜色没有改变，于是增加表格的内容，重新提问，生成代码如下；

vbnet 复制代码

Sub SetAllTextAndTableTextToBlack()
    Dim sld As Slide
    Dim shp As Shape
    Dim tbl As Table
    Dim rw As Long, cl As Long
    Dim cell As cell
  
    ' 遍历每个幻灯片
    For Each sld In ActivePresentation.Slides
        ' 遍历每个形状
        For Each shp In sld.Shapes
            ' 检查形状是否为表格
            If shp.HasTable Then
                Set tbl = shp.Table
                ' 遍历表格的每一行和列
                For rw = 1 To tbl.Rows.Count
                    For cl = 1 To tbl.Columns.Count
                        Set cell = tbl.cell(rw, cl)
                        ' 设置单元格中文本的字体颜色为黑色
                        cell.Shape.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
                          
                        ' 如果单元格包含多个段落（虽然表格单元格通常不这样），也可以遍历它们
                        ' 但对于简单的字体颜色更改，上面的设置就足够了
                    Next cl
                Next rw
            ' 检查形状是否包含文本（即，是否为文本框或类似的文本容器）
            ElseIf shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    ' 设置文本框中文本的字体颜色为黑色
                    shp.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
                End If
            End If
        Next shp
    Next sld
End Sub

直接跑，运行后，ok

删除图片

那么，我还想删除其中的所有的背景图片，重新提问，

使用vba写一段代码，删除每一页PPT中图片宽大于7的图片

vbnet 复制代码

Sub DeleteWideImagesFromEachSlide()  
    Dim sld As Slide  
    Dim shp As Shape  
      
    ' 遍历每张幻灯片  
    For Each sld In ActivePresentation.Slides  
        ' 遍历幻灯片上的每个形状  
        For Each shp In sld.Shapes  
            ' 检查形状是否为图片  
            If shp.Type = msoPicture Then  
                ' 检查图片的宽度是否大于7（注意：这里的单位取决于PowerPoint的设置，通常是磅或厘米）  
                If shp.Width > 7 Then  
                    ' 删除宽度大于7的图片  
                    shp.Delete  
                    ' 注意：删除形状后，集合会发生变化，因此不能继续在当前循环中迭代  
                    ' 使用GoTo语句跳出内层循环（虽然这不是最佳实践，但在这种情况下是可行的）  
                    GoTo ContinueOuterLoop  
                End If  
            End If  
ContinueOuterLoop:  
        Next shp  
    Next sld  
End Sub

直接跑，图片没被删除，发下是文本框，重新使用rpa进行模拟鼠标操作进行删除

最终ppt的结果如下，漂亮。。。。