PowerPoint VBA將圖像添加到每張幻燈片

Question

我正在編寫一個簡單的宏來更改字體並為電源點中的每張幻燈片添加徽標。

問題是每張幻燈片上的字體都在更新，但圖片只粘貼在一張幻燈片上。 - 所以我最終在一張幻燈片上放了30張圖片（根據我的要求，每張幻燈片上沒有1張圖片）

我有以下內容：

Sub InsertLogoOnEveryPage()

Dim sld As Slide
Dim shp As Shape
Dim sFontName As String
Dim oTop As Integer

' font:
sFontName = "Times"

For Each sld In ActivePresentation.Slides

    Debug.Print sld.Name
    'Insert logo.
    ActiveWindow.Selection.SlideRange.Shapes.AddPicture( _
    FileName:="PATH\Logo_RGB.png", _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=60, Top:=oTop, _
    Width:=330, Height:=330).Select

    For Each shp In sld.Shapes
        With shp
            If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        .TextFrame.TextRange.Font.Name = sFontName
                    End If
                End If
        End With
    Next shp
    oTop = oTop + 10
Next sld

End Sub

解決這個問題的任何幫助都會很棒，謝謝！

Answer 1

2件事：

關於您的代碼：盡量避免使用.Select和Selection

ActiveWindow.Selection.SlideRange.Shapes.AddPicture應為sld.Shapes.AddPicture

ActiveWindow只是PPT應用程序中的可見幻燈片。

關於這個想法：

您應該轉到“ View菜單，“ Slide Master並編輯您使用的默認布局，以避免使用某些代碼！ ;）

Sub InsertLogoOnEveryPage()

Dim sld As Slide
Dim shp As Shape
Dim sFontName As String
Dim oTop As Single

' font:
sFontName = "Times"

For Each sld In ActivePresentation.Slides

    Debug.Print sld.Name
    'Insert logo.
    sld.Shapes.AddPicture FileName:="C:\Users\R3uKH2\Desktop\Dive zones.png", _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, Left:=60, Top:=oTop, _
        Width:=330, Height:=330

    For Each shp In sld.Shapes
        With shp
            If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        .TextFrame.TextRange.Font.Name = sFontName
                    End If
                End If
        End With
    Next shp
    oTop = oTop + 10
Next sld

End Sub

Answer 2

你考慮過使用大師賽嗎？ Master將允許您為使用該Master的所有幻燈片定義字體和圖像。