vba - PowerPoint VBA 将图像添加到每张幻灯片

Question

我正在编写一个简单的宏来更改字体并为 power point 中的每张幻灯片添加 Logo 。

问题是字体在每张幻灯片上都在更新，但图像只粘贴在一张幻灯片上。 - 所以我最终在一张幻灯片上有 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