帮同学改ppt的文字格式，用vba代码自动化修改，方便很多啊。代码值得留存，方便以后再用。本来如果有时间可以用VS编的，可惜最近时间比较紧。

小技巧：有不知道如何改的，先录制宏，根据宏代码改编程序。不过2003之前的能录制宏，07、10据说都没有这功能了。

直接上代码

' 修改文字

Sub Text()
On Error Resume Next
Dim oPres As Presentation
Set oPres = Application.ActivePresentation
Dim oSlide As Slide
Dim oShape As Shape
Dim tr As TextRange
Dim sText As String
Dim i As Long, j As Long

'循环每页幻灯
For i = 1 To oPres.Slides.Count
    Set oSlide = oPres.Slides.Item(i)
    For j = 1 To oSlide.Shapes.Count
        Set oShape = oSlide.Shapes.Item(j)
       
        With oShape
            '.Fill.ForeColor.SchemeColor = ppBackground
            '.Fill.Solid
            '.Fill.Transparency = 0#
            .Fill.Visible = msoFalse
        End With
        '如果有文字
        If oShape.TextFrame.HasText = msoTrue Then
            Set tr = oShape.TextFrame.TextRange
            tr.Font.Color.SchemeColor = ppForeground
            Set tr = Nothing
        End If
       
        Set oShape = Nothing
    Next
    Set oSlide = Nothing
Next
Set oPres = Nothing
End Sub
' 修改公式
Sub Equations()
On Error Resume Next
Dim oPres As Presentation
Set oPres = Application.ActivePresentation
Dim oSlide As Slide
Dim oShape As Shape
Dim tr As TextRange
Dim sText As String
Dim i As Long, j As Long

'循环每页幻灯
For i = 1 To oPres.Slides.Count
    Set oSlide = oPres.Slides.Item(i)
    '获取图形对象
    For j = 1 To oSlide.Shapes.Count
        Set oShape = oSlide.Shapes.Item(j)
        'oShape.Select
        
       If oShape.Type = msoEmbeddedOLEObject Then
            'If oShape.PictureFormat.Parent.OLEFormat.ProgID <> "Paint.Picture" Then
                With oShape
                .PictureFormat.ColorType = msoPictureAutomatic
                .PictureFormat.Brightness = 0
                .PictureFormat.Contrast = 0.5
                End With
            'End If
        End If

        Set oShape = Nothing
    Next
    Set oSlide = Nothing
Next
Set oPres = Nothing
End Sub
' 修改框
Sub frames()
On Error Resume Next
Dim oPres As Presentation
Set oPres = Application.ActivePresentation
Dim oSlide As Slide
Dim oShape As Shape
Dim tr As TextRange
Dim sText As String
Dim i As Long, j As Long

'循环每页幻灯
For i = 1 To oPres.Slides.Count
    Set oSlide = oPres.Slides.Item(i)
    '获取图形对象
    For j = 1 To oSlide.Shapes.Count
        Set oShape = oSlide.Shapes.Item(j)
                
       If oShape.Type = msoAutoShape Then
            'If oShape.PictureFormat.Parent.OLEFormat.ProgID <> "Paint.Picture" Then
                With oShape
                .PictureFormat.ColorType = msoPictureAutomatic
                .PictureFormat.Brightness = 0
                .PictureFormat.Contrast = 0.5
                .Fill.Transparency = 1#
                End With
            'End If
        End If

        Set oShape = Nothing
    Next
    Set oSlide = Nothing
Next
Set oPres = Nothing
End Sub
' 修改组合框
Sub groupframes()
On Error Resume Next
On Error Resume Next
Dim oPres As Presentation
Set oPres = Application.ActivePresentation
Dim oSlide As Slide
Dim oShape As Shape
Dim tr As TextRange
Dim sText As String
Dim i As Long, j As Long

'循环每页幻灯
For i = 1 To oPres.Slides.Count
    Set oSlide = oPres.Slides.Item(i)
    '获取图形对象
    For j = 1 To oSlide.Shapes.Count
        Set oShape = oSlide.Shapes.Item(j)
                
        If oShape.Type = msoGroup Then
            'If oShape.PictureFormat.Parent.OLEFormat.ProgID <> "Paint.Picture" Then
                With oShape
                .PictureFormat.Brightness = 0
                .PictureFormat.Contrast = 0.5
                .PictureFormat.ColorType = msoPictureAutomatic
                .Fill.Transparency = 1#
                End With
            'End If
        End If

        Set oShape = Nothing
    Next
    Set oSlide = Nothing
Next
Set oPres = Nothing
End Sub

' Test
Sub Test()
On Error Resume Next
Dim oPres As Presentation
Set oPres = Application.ActivePresentation
Dim oSlide As Slide
Dim oShape As Shape
Dim tr As TextRange
Dim sText As String
Dim i As Long, j As Long

'循环每页幻灯
For i = 22 To 22 'oPres.Slides.Count
    Set oSlide = oPres.Slides.Item(i)
    '获取图形对象
    For j = 1 To oSlide.Shapes.Count
        Set oShape = oSlide.Shapes.Item(j)
        oShape.Select

         If oShape.Type = msoEmbeddedOLEObject Then
            'If oShape.PictureFormat.Parent.OLEFormat.ProgID <> "Paint.Picture" Then
                With oShape
                .PictureFormat.ColorType = msoPictureAutomatic
                .PictureFormat.Brightness = 0.5
                .PictureFormat.Contrast = 0.5
                End With
            'End If
        End If

        Set oShape = Nothing
    Next
    Set oSlide = Nothing
Next
Set oPres = Nothing
End Sub

Sub Macro1()
    With ActiveWindow.Selection.ShapeRange
        .Fill.Transparency = 0#
        .PictureFormat.Brightness = 0#
    End With
    With ActiveWindow.Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.Solid
        .Fill.ForeColor.SchemeColor = ppBackground
        .Fill.Transparency = 0#
        .Line.Visible = msoFalse
    End With
    ActiveWindow.Selection.Unselect
End Sub
Sub Macro2()
    ActiveWindow.Selection.SlideRange.Shapes("Object 33").Select
    With ActiveWindow.Selection.ShapeRange
        .IncrementLeft 2.25
        .IncrementTop -1.12
    End With
    With ActiveWindow.Selection.ShapeRange
        .Fill.Transparency = 0#
        .PictureFormat.Brightness = 0#
    End With
    With ActiveWindow.Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.Solid
        .Fill.ForeColor.SchemeColor = ppBackground
        .Fill.Transparency = 0#
        .Line.Visible = msoFalse
    End With
End Sub
Sub Macro3()
    ActiveWindow.Selection.ShapeRange.Fill.Transparency = 0#
    With ActiveWindow.Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.Solid
        .Fill.ForeColor.SchemeColor = ppBackground
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .Line.BackColor.RGB = RGB(255, 255, 255)
    End With
    ActiveWindow.Selection.ShapeRange.Fill.Transparency = 1#
End Sub