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 будет только видимый слайд в вашем приложении РРТ.

Об идее:

Вы должны пойти в 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

Вы считаете, что используете мастера? Мастер позволит вам определить шрифт и изображение для всех слайдов, которые используют этот мастер.