echo打印显示醒目颜色

在PowerPoint 2003下运行通过，使用时只要随便新建一个宏，把它自动生成的代码全删去，粘贴上面这段代码。然后运行ReColor 这个宏就可以了（副作用，自选图形线条颜色也变成了黑色）。

' The macro to excute  
Sub ReColor()  
    Dim sld As Slide  
    Dim sh As Shape  
    For Each sld In ActivePresentation.Slides  
        For Each sh In sld.Shapes  
            Call ReColorSH(sh)  
        Next  
    Next  
End Sub
  
Function ReColorSH(sh As Shape)  
    Dim ssh As Shape  
    If sh.Type = msoGroup Then ' when the shape itself is a group  
        For Each ssh In sh.GroupItems  
        Call ReColorSH(ssh)  ' the recursion  
        Next  
        '改变公式中文字的颜色为黑色，不知如何设置为其他颜色  
        ElseIf sh.Type = msoEmbeddedOLEObject Then ' recolor the equation
	    If Left(sh.OLEFormat.ProgID, 8) = "Equation" Then 
                sh.PictureFormat.ColorType = msoPictureBlackAndWhite  
                sh.PictureFormat.Brightness = 0  
                sh.PictureFormat.Contrast = 1  
                sh.Fill.Visible = msoFalse
	    End If
        '改变文本框中文字的颜色，可自己设定  
        ElseIf sh.HasTextFrame Then  
            ' /* 当前幻灯片中的当前形状包含文本. */  
            If sh.TextFrame.HasText Then  
                ' 引用文本框架中的文本.  
                Set trng = sh.TextFrame.TextRange  
                ' /* 遍历文本框架中的每一个字符. */  
                For i = 1 To trng.Characters.Count  
                    ' 这里请自行修改为原来的颜色值 (白色).  
                    'If trng.Characters(i).Font.Color = vbWhite Then  
                        ' 这里请自行修改为要替换的颜色值 (黑色).  
                        trng.Characters(i).Font.Color = vbBlack  
                    'End If  
                Next  
            End If  
    End If  
End Function 
' The macro to excute
Sub ReColor()
Dim sld As Slide
Dim sh As Shape
For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
Call ReColorSH(sh)
Next
Next
End Sub

Sub ReColorSH(sh As Shape)
Dim ssh As Shape
If sh.Type = msoGroup Then ' when the shape itself is a group
For Each ssh In sh.GroupItems
ReColorSH(ssh) ' the recursion
Next
ElseIf sh.Type = msoEmbeddedOLEObject Then ' recolor the equation
If Left(sh.OLEFormat.ProgID, 8) = "Equation" Then
sh.BlackWhiteMode = msoBlackWhiteBlack
End If
End If
End Sub
' VBA cannot pass Shape into a function, so global var is used
Public sh As Shape

' The macro to excute
Sub ReColor()
Dim sld As Slide

For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
Call ReColorSH
Next
Next
End Sub

Sub ReColorSH()
Dim ip As Integer ' point to the top of the i stack
Dim sp As Integer ' point to the top of the shape stack
Dim istk() As Integer ' the i stack, using dynamic array
Dim sstk() As Shape ' the Shape stack, using dynamic array
Dim ssize As Integer ' the size of both stacks

ssize = 10
ReDim istk(ssize)
ReDim sstk(ssize)

ip = 0
sp = 0

Dim i As Integer
L2: If sh.Type = msoGroup Then
i = 1
L1: 'pushS(sh)
sp = sp + 1
If sp > ssize Then
ssize = ssize + 1
ReDim Preserve istk(ssize)
ReDim Preserve sstk(ssize)
End If
Set sstk(sp) = sh
'----------
'pushI (i)
ip = ip + 1
istk(ip) = i
'----------
Set sh = sh.GroupItems(i)
GoTo L2
L3: 'popI(i)
i = istk(ip)
ip = ip - 1
'----------
'popS(sh)
Set sh = sstk(sp)
sp = sp - 1
'----------
If i < sh.GroupItems.Count Then
i = i + 1
GoTo L1
End If
ElseIf sh.Type = msoEmbeddedOLEObject Then
If Left(sh.OLEFormat.ProgID, 8) = "Equation" Then
sh.BlackWhiteMode = msoBlackWhiteBlack
End If
End If
If ip > 0 Then GoTo L3
End Sub
Sub Demo()
    Dim s       As Slide
    Dim shp     As Shape
    Dim trng    As TextRange
    Dim i       As Integer
     
    ' /* 遍历活动窗口中打开的演示文稿中的幻灯片. */
    For Each s In ActivePresentation.Slides
        ' /* 遍历当前幻灯片中的形状对象. */
        For Each shp In s.Shapes
            ' /* 当前幻灯片中的当前形状含有文本框架. */
            If shp.HasTextFrame Then
                ' /* 当前幻灯片中的当前形状包含文本. */
                If shp.TextFrame.HasText Then
                    ' 引用文本框架中的文本.
                    Set trng = shp.TextFrame.TextRange
                     
                    ' /* 遍历文本框架中的每一个字符. */
                    For i = 1 To trng.Characters.Count
                        ' 这里请自行修改为原来的颜色值 (浅绿色).
                        If trng.Characters(i).Font.Color = vbRed Then
                            ' 这里请自行修改为要替换的颜色值 (深绿色).
                            trng.Characters(i).Font.Color = vbBlue
                        End If
                    Next
                End If
            End If
        Next
    Next
End Sub
Sub change_text_color()  
Dim oSld As Slide  
Dim oShp As Shape  
Dim oShapes As Shapes  
Dim textColor As RGBColor  
For Each oSld In ActivePresentation.Slides  
    Set oShapes = oSld.Shapes  
    For Each oShp In oShapes         
        If oShp.Type = 7 Then          
            oShp.PictureFormat.ColorType = msoPictureBlackAndWhite  
            oShp.PictureFormat.Brightness = 0  
            oShp.PictureFormat.Contrast = 1  
            oShp.Fill.Visible = msoFalse              
        End If  
    Next oShp  
Next oSld  
End Sub