CODEWITHSUNDEEP
vbapowerpoint
Ali_bean
Ali_bean

Reputation: 341

PowerPoint VBA adding image to every slide

I'm writing a simple macro to change the font and add a logo to every slide in a power point.

The problem is that the font is updating on every slide, but the image is only pasting on a single slide. - So I end up with 30 images on top of each other on a single slide (not 1 image on each slide as I require)

I have the following:

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

Any help on solving this would be awesome, thanks!

Upvotes: 3

Views: 3429

Answers (2)

R3uK
R3uK

Reputation: 14537

2 things :

About your code : Try to avoid using .Select and Selection

ActiveWindow.Selection.SlideRange.Shapes.AddPicture should be sld.Shapes.AddPicture

ActiveWindow will only be the visible slide in your PPT app.

About the idea :

You should go to View menu, Slide Master and edit the default layout that you use to avoid using some code! ;)

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

Upvotes: 3

ThunderFrame
ThunderFrame

Reputation: 9461

Have you considered using Masters? A Master will allow you to define a font and image for all Slides that use that Master.

Upvotes: 1

Related Questions