「A改成淡化動畫」、「B刪除音效」、「C統一字體」、「D刪除動畫」、「同時運行ABC」

如果你要一次過在所有投影片上的把動畫「A改成淡化動畫」，可運行以下VBA代碼：

Sub ChangeAnimationsToFadeOut()
    Dim oSlide As Slide
    Dim oEffect As Effect
    Dim oPresentation As Presentation

    Set oPresentation = ActivePresentation

    ' 遍歷每個幻燈片
    For Each oSlide In oPresentation.Slides
        ' 遍歷每個幻燈片上的動畫效果
        For Each oEffect In oSlide.TimeLine.MainSequence
            ' 將動畫效果更改為淡出效果
            oEffect.EffectType = msoAnimEffectFade
            ' 設置淡出效果的速度
            oEffect.Timing.Duration = 0.5
        Next oEffect
    Next oSlide
End Sub

要運行此代碼，請按照以下步驟操作：

1. 打開您要修改的PowerPoint簡報。
2. 按下 Alt + F11 鍵，打開VBA編輯器。
3. 在VBA編輯器中，單擊菜單中的 插入 > 模組，在新模組中粘貼上面的代碼。
4. 按下 F5 鍵執行代碼，或者在VBA編輯器中單擊菜單中的 執行 > 執行Sub / UserForm。執行完畢後，代碼已無用。
5. 退出VBA編輯器，儲存文件，選「是」儲存為無巨集的普通文件。

現在，您的簡報中的所有動畫效果都將更改為淡化效果。

如果你要的不是淡化效果，而是其他動畫效果，可以參考以下：

MsoAnimEffect 枚舉 （PowerPoint） | Microsoft Learn

如果你要在所有動畫的「B刪除音效」，可運行以下VBA代碼：

Sub MuteAllAnimationSounds()
    Dim sld As Slide
    Dim eff As Effect
    For Each sld In ActivePresentation.Slides
        For Each eff In sld.TimeLine.MainSequence
            ' 只針對有聲音的動畫設為無聲
            If eff.EffectInformation.SoundEffect.Type <> msoSoundNone Then
                eff.EffectInformation.SoundEffect.Type = msoSoundNone
            End If
        Next eff
    Next sld
    ' MsgBox "所有動畫聲音已設為靜音！"
End Sub

如果你要在所有頁面的「C統一字體」為微軟正黑體 (可自行修改)，可運行以下VBA代碼：

Sub ChangeAllFontsIncludingMasters()
    Dim slideItem As Slide
    Dim designItem As Design
    Dim layoutItem As CustomLayout
    Dim shapeItem As Shape
    
    On Error Resume Next ' 避免部分特殊物件屬性引發錯誤而中斷執行
    
    ' 1. 處理所有普通投影片頁面
    For Each slideItem In ActivePresentation.Slides
        For Each shapeItem In slideItem.Shapes
            ProcessShape shapeItem
        Next shapeItem
    Next slideItem
    
    ' 2. 處理所有投影片母片 (Slide Masters)
    For Each designItem In ActivePresentation.Designs
        For Each shapeItem In designItem.SlideMaster.Shapes
            ProcessShape shapeItem
        Next shapeItem
        
        ' 3. 處理母片底下的所有版面配置 (Custom Layouts)
        For Each layoutItem In designItem.SlideMaster.CustomLayouts
            For Each shapeItem In layoutItem.Shapes
                ProcessShape shapeItem
            Next shapeItem
        Next layoutItem
    Next designItem
    
    On Error GoTo 0
    
    ' MsgBox "全簡報（包含頁面、母片與版面配置）字體已成功統一為微軟正黑體！", vbInformation, "完成"
End Sub

' 遞迴處理各種圖形物件的子程式
Private Sub ProcessShape(shp As Shape)
    Dim rowIdx As Long, colIdx As Long
    Dim subShape As Shape
    
    ' 處理組合圖形（Group）- 遞迴支援多層組合
    If shp.Type = msoGroup Then
        For Each subShape In shp.GroupItems
            ProcessShape subShape
        Next subShape
        
    ' 處理表格（Table）
    ElseIf shp.HasTable Then
        With shp.Table
            For rowIdx = 1 To .Rows.Count
                For colIdx = 1 To .Columns.Count
                    If .Cell(rowIdx, colIdx).Shape.HasTextFrame Then
                        SetFont .Cell(rowIdx, colIdx).Shape.TextFrame
                    End If
                Next colIdx
            Next rowIdx
        End With
        
    ' 處理一般文字方塊、圖案、預留位置 (Placeholder)
    ElseIf shp.HasTextFrame Then
        SetFont shp.TextFrame
    End If
End Sub

' 設定字體的輔助子程式（同時設定中、英與複雜文字屬性）
Private Sub SetFont(tf As TextFrame)
    Const TARGET_FONT As String = "微軟正黑體"
    
    If tf.HasText Then
        With tf.TextRange.Font
            .Name = TARGET_FONT             ' 西文/拉丁字體
            .NameFarEast = TARGET_FONT       ' 中文/東亞字體
            .NameComplexScript = TARGET_FONT ' 複雜語系字體
        End With
    End If
End Sub

如果你要一次過在所有投影片上的「D刪除所有動畫」，可運行以下VBA代碼：

Sub DeleteAllAnimations()
    Dim oSlide As Slide
    Dim oShape As Shape
    For Each oSlide In ActivePresentation.Slides
        For Each oShape In oSlide.Shapes
            oShape.AnimationSettings.EntryEffect = ppEffectNone
            oShape.AnimationSettings.AdvanceMode = ppAdvanceModeMixed
            oShape.AnimationSettings.AdvanceMode = ppAdvanceMouseClick
        Next oShape
    Next oSlide
End Sub

一次同時運行「A改淡化動畫+B刪除音效+C統一字體」三個巨集

Sub AllMacros()
    ' 依序呼叫三個巨集
    Call ChangeAllFontsIncludingMasters
    Call ChangeAnimationsToFadeOut
    Call MuteAllAnimationSounds
End Sub

Sub ChangeAnimationsToFadeOut()
    Dim oSlide As Slide
    Dim oEffect As Effect
    Dim oPresentation As Presentation

    Set oPresentation = ActivePresentation

    ' 遍歷每個幻燈片
    For Each oSlide In oPresentation.Slides
        ' 遍歷每個幻燈片上的動畫效果
        For Each oEffect In oSlide.TimeLine.MainSequence
            ' 將動畫效果更改為淡出效果
            oEffect.EffectType = msoAnimEffectFade
            ' 設置淡出效果的速度
            oEffect.Timing.Duration = 0.5
        Next oEffect
    Next oSlide
End Sub



Sub MuteAllAnimationSounds()
    Dim sld As Slide
    Dim eff As Effect
    For Each sld In ActivePresentation.Slides
        For Each eff In sld.TimeLine.MainSequence
            ' 只針對有聲音的動畫設為無聲
            If eff.EffectInformation.SoundEffect.Type <> msoSoundNone Then
                eff.EffectInformation.SoundEffect.Type = msoSoundNone
            End If
        Next eff
    Next sld
    ' MsgBox "所有動畫聲音已設為靜音！"
End Sub



Sub ChangeAllFontsIncludingMasters()
    Dim slideItem As Slide
    Dim designItem As Design
    Dim layoutItem As CustomLayout
    Dim shapeItem As Shape
    
    On Error Resume Next ' 避免部分特殊物件屬性引發錯誤而中斷執行
    
    ' 1. 處理所有普通投影片頁面
    For Each slideItem In ActivePresentation.Slides
        For Each shapeItem In slideItem.Shapes
            ProcessShape shapeItem
        Next shapeItem
    Next slideItem
    
    ' 2. 處理所有投影片母片 (Slide Masters)
    For Each designItem In ActivePresentation.Designs
        For Each shapeItem In designItem.SlideMaster.Shapes
            ProcessShape shapeItem
        Next shapeItem
        
        ' 3. 處理母片底下的所有版面配置 (Custom Layouts)
        For Each layoutItem In designItem.SlideMaster.CustomLayouts
            For Each shapeItem In layoutItem.Shapes
                ProcessShape shapeItem
            Next shapeItem
        Next layoutItem
    Next designItem
    
    On Error GoTo 0
    
    ' MsgBox "全簡報（包含頁面、母片與版面配置）字體已成功統一為微軟正黑體！", vbInformation, "完成"
End Sub

' 遞迴處理各種圖形物件的子程式
Private Sub ProcessShape(shp As Shape)
    Dim rowIdx As Long, colIdx As Long
    Dim subShape As Shape
    
    ' 處理組合圖形（Group）- 遞迴支援多層組合
    If shp.Type = msoGroup Then
        For Each subShape In shp.GroupItems
            ProcessShape subShape
        Next subShape
        
    ' 處理表格（Table）
    ElseIf shp.HasTable Then
        With shp.Table
            For rowIdx = 1 To .Rows.Count
                For colIdx = 1 To .Columns.Count
                    If .Cell(rowIdx, colIdx).Shape.HasTextFrame Then
                        SetFont .Cell(rowIdx, colIdx).Shape.TextFrame
                    End If
                Next colIdx
            Next rowIdx
        End With
        
    ' 處理一般文字方塊、圖案、預留位置 (Placeholder)
    ElseIf shp.HasTextFrame Then
        SetFont shp.TextFrame
    End If
End Sub

' 設定字體的輔助子程式（同時設定中、英與複雜文字屬性）
Private Sub SetFont(tf As TextFrame)
    Const TARGET_FONT As String = "微軟正黑體"
    
    If tf.HasText Then
        With tf.TextRange.Font
            .Name = TARGET_FONT             ' 西文/拉丁字體
            .NameFarEast = TARGET_FONT       ' 中文/東亞字體
            .NameComplexScript = TARGET_FONT ' 複雜語系字體
        End With
    End If
End Sub