PowerPoint VBA 向每张幻灯片添加图像

PowerPoint VBA adding image to every slide

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

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

任何解决此问题的帮助都很棒,谢谢!

您是否考虑过使用 Masters?母版将允许您为使用该母版的所有幻灯片定义字体和图像。

2 件事:

关于您的代码: 尽量避免使用 .SelectSelection

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