放弃使用，几篇文章搬运过来

在 视图—>宏 内新建宏

'终极版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    ActivePresentation.ExtraColors.Add RGB(Red:=255, Green:=255, Blue:=255)    If ActivePresentation.HasTitleMaster Then        With ActivePresentation.TitleMaster.Background            .Fill.Visible = msoTrue            .Fill.ForeColor.RGB = RGB(255, 255, 255)            .Fill.Transparency = 0#            .Fill.Solid        End With    End If    With ActivePresentation.SlideMaster.Background        .Fill.Visible = msoTrue        .Fill.ForeColor.RGB = RGB(255, 255, 255)        .Fill.Transparency = 0#        .Fill.Solid    End With    With ActivePresentation.Slides.Range        .FollowMasterBackground = msoTrue        .DisplayMasterShapes = msoFalse    End WithEnd 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 IfEnd Function

命名为Recolor后运行，即可将整个PPT全变成黑白，方便打印