PPT特定颜色字体批量变色

glg007

有一套PPt，大概有1000多页，我需要打印出来学习用。

但是，部分字体是白色，背景是绿色，打印太费墨了。

需求：黄体字体不变，白色字体全部改成黑色。

我在网上搜了一个VBA代码，只能修改部分白色字体的颜色，框内的白色字体不能改变。（图片是下面的代码运行的结果）

请大神帮我改一下，顺便告诉我如何把背景的绿色去掉。非常感谢！详见附件。

1. Sub ReplaceColor()
   
2. Dim shape As shape
   
3. Dim slide As slide
   
4. Dim txt As TextRange
   
5. On Error Resume Next
   
6. '替换背景颜⾊为⽩⾊
   
7. ActivePresentation.SlideMaster.Background.Fill.Solid
   
8. ActivePresentation.SlideMaster.Background.Fill.ForeColor.RGB = RGB(255, 255, 255)
   
9. For Each slide In ActivePresentation.Slides
   
10. For Each shape In slide.Shapes
    
11. Set txt = shape.TextFrame.TextRange
    
12. For Each sentence In txt.Sentences
    
13. For Each word In sentence.Words
    
14. '把白⾊的⽂字替换成黑⾊
    
15. If word.Font.color.RGB = RGB(0, 0, 204) Or word.Font.color.RGB = RGB(0, 0, 122) Then
    
16. With word.Font
    
17. .color.RGB = RGB(40, 40, 40)
    
18. End With
    
19. End If
    
20. Next
    
21. Next
    
22. Next
    
23. Next
    
24. End Sub

复制代码

Eric0236

1. Sub ReplaceColor()
   
2.     Dim oshape As Shape
   
3.     Dim oslide As Slide
   
4.     Dim otxt As TextRange
   
5.     Dim otable As Table
   
6.     Dim ocell As Cell
   
7.     Dim oppt As Presentation
   
8.     Dim i, j, k As Integer
   
9.    
   
10.     On Error Resume Next
    
11. 
    
12.     For Each oslide In ActivePresentation.Slides
    
13.         For Each oshape In oslide.Shapes
    
14.             If oshape.HasTextFrame Then     '设置文本框
    
15.                 If oshape.TextFrame.HasText Then
    
16.                     Set otxt = oshape.TextFrame.TextRange
    
17.                     For i = 1 To Len(otxt)
    
18.                         If otxt.Characters(i).Font.Color.RGB = vbWhite Then      '更改白色字体为黑色
    
19.                             otxt.Characters(i).Font.Color.RGB = RGB(40, 40, 40)
    
20.                         End If
    
21.                     Next
    
22.                 End If
    
23.             End If
    
24.             
    
25.             If oshape.HasTable Then     '设置表格
    
26.                 Set otable = oshape.Table
    
27.                 With otable
    
28.                     icol = .Columns.Count
    
29.                     irow = .Rows.Count
    
30.                     For i = 1 To irow
    
31.                         For j = 1 To icol
    
32.                             Set ocell = .Cell(i, j)
    
33.                             Set otxt = .Cell(i, j).Shape.TextFrame.TextRange
    
34.                             For k = 1 To Len(otxt)      '更改白色字体为黑色
    
35.                                 If otxt.Characters(k).Font.Color.RGB = vbWhite Then
    
36.                                     otxt.Characters(k).Font.Color.RGB = RGB(40, 40, 40)
    
37.                                 End If
    
38.                             Next k
    
39.                             ocell.Borders(ppBorderBottom).ForeColor.RGB = vbBlack
    
40.                             ocell.Borders(ppBorderTop).ForeColor.RGB = vbBlack
    
41.                             ocell.Borders(ppBorderLeft).ForeColor.RGB = vbBlack
    
42.                             ocell.Borders(ppBorderRight).ForeColor.RGB = vbBlack
    
43.                         Next j
    
44.                     Next i
    
45.                 End With
    
46.             End If
    
47.             
    
48.             If oshape.Width = oppt.PageSetup.SlideWidth And oshape.Height = oppt.PageSetup.SlideHeight Then     '全屏大小的形状改成白色
    
49.                 oshape.Fill.ForeColor.RGB = vbWhite
    
50.             End If
    
51.         Next
    
52.     Next
    
53.         
    
54. End Sub

复制代码

glg007

Eric0236 发表于 2022-9-14 15:31

大神，请让我顶礼膜拜一下！

我的问题解决了，非常感谢。