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的所有幻灯片定义字体和图像。

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

2 个答案: