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

两件事：

关于你的代码：尽量避免使用.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 的所有幻灯片定义字体和图像。