如果你要一次過在所有投影片上的把動畫「改成淡化動畫」,可運行以下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
要運行此代碼,請按照以下步驟操作:
- 打開您要修改的PowerPoint簡報。
- 按下 Alt + F11 鍵,打開VBA編輯器。
- 在VBA編輯器中,單擊菜單中的 插入 > 模組,在新模組中粘貼上面的代碼。
- 按下 F5 鍵執行代碼,或者在VBA編輯器中單擊菜單中的 執行 > 執行Sub / UserForm。執行完畢後,代碼已無用。
- 退出VBA編輯器,儲存文件,選「是」儲存為無巨集的普通文件。
現在,您的簡報中的所有動畫效果都將更改為淡化效果。
如果你要的不是淡化效果,而是其他動畫效果,可以參考以下:
MsoAnimEffect 枚舉 (PowerPoint) | Microsoft Learn
如果你要一次過在所有投影片上的「刪除所有動畫」,可運行以下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
如果你要在所有動畫的「刪除音效」,可運行以下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
如果你要在所有動畫的「統一字體」為微軟正黑體 (可自行修改),可運行以下VBA代碼:
Sub ChangeAllFontsComprehensive()
Dim osld As Slide
Dim oshp As Shape
Dim targetFont As String
' 請將此處修改為你想統一替換成的字型名稱
targetFont = "微軟正黑體"
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
ProcessShape oshp, targetFont
Next oshp
Next osld
' MsgBox "全檔字型(含中文 FarEast 及表格/群組)已統一修改完成!", vbInformation
End Sub
Private Sub ProcessShape(oshp As Shape, fontName As String)
Dim i As Long, r As Long, c As Long
Dim subShape As Shape
' 1. 處理普通文字方塊與圖案
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
With oshp.TextFrame.TextRange.Font
.Name = fontName ' 拉丁/英文字型
.NameFarEast = fontName ' 中文/東亞字型
.NameAscii = fontName
.NameOther = fontName
End With
End If
End If
' 2. 處理表格 (Table)
If oshp.HasTable Then
For r = 1 To oshp.Table.Rows.Count
For c = 1 To oshp.Table.Columns.Count
With oshp.Table.Cell(r, c).Shape.TextFrame.TextRange.Font
.Name = fontName
.NameFarEast = fontName
.NameAscii = fontName
.NameOther = fontName
End With
Next c
Next r
End If
' 3. 處理組合圖形 (Group Shape)
If oshp.Type = msoGroup Then
For Each subShape In oshp.GroupItems
ProcessShape subShape, fontName
Next subShape
End If
End Sub