Writing Macros in PPT

Posted on 2010-01-08
Last Modified: 2012-05-08
I have 5 text boxes on one slide and have 20 slides in a PPT file.

I need 3 things
1. Change font size of the text boxes (except the title text box, appearing on top) on each slide
2. Change font size of title text box only
3. Update slide numbers in the PPT

Note: I need a macro for point # 1, 2 & 3 and not go by Master slide technique.
Question by:PiyusKanti
    LVL 23

    Expert Comment

    Code would be simple BUT ...

    You need to explain EXACTLY what you have and what you need.

    WHY can't you use the master to specify font sizes?

    1. Have you created a custom layout which has a title placeholder and five text placeholders
    2. Are you using the title only layout and have added five normal textboxes to each slide?

    "Update slide numbers" What does this mean slide numbers update automatically
    LVL 1

    Author Comment


    I do lots of copy / paste job from 1 ppt to another.
    So for eg.
    I would copy a slide from PPT1 to PPT2, thus I need to keep the formatting of this new slide in PPT2.

    I thus need a macro to change the fonts and update slide number of this new slide.
    I am  using the title only layout and have added five normal textboxes to each slide.

    Please, provide me with the ncessary code.

    LVL 23

    Expert Comment

    It's still not completely clear what you need. The code below will change all text NOT in placeholders controlled by the Master to 20 point Arial in a red color and NOT bold or italic. You can of course alter these settings.
    Sub swap_font()
    Dim oshp As Shape
    Dim osld As Slide
    For Each osld In ActivePresentation.Slides
    For Each oshp In osld.Shapes
    If oshp.Type <> msoPlaceholder Then
    If oshp.HasTextFrame Then
    If oshp.TextFrame.HasText Then
    With oshp.TextFrame.TextRange.Font
    '~~~~~~~~~~~~~~~~~~change below as required
    .Name = "Arial"
    .Size = 20
    .Color.RGB = RGB(255, 122, 122)
    .Bold = False
    .Italic = False
    End With
    End If 'hastext
    End If 'textframe
    End If ' placeholder
    Next oshp
    Next osld
    End Sub

    Open in new window

    LVL 1

    Author Comment

    Hi Expert,

    It helped, Just one more thing.

    How do I set the fonts to "Calibri (Body)" & "Calibri Heading" in the same code.

    Becuse, if I change the font from "Calibri" to "Calibri (Body)" as

    .Name = "Calibri (Body)"

    all texts gets overlapped. and if I do this step manually there is no overlapping. Pls help.
    LVL 3

    Accepted Solution

    See the attached to handle your Page Number issue. It assumes and does the following:

    You have a Title Slide.
    You have an Agenda Slide of some kind - ususally the 2nd slide. It's called "Agenda" - you can rename that of course or reference it as the 2nd slide - amend the code as required.
    It cycles throughn the presentation and inserts a text box and formats it - you can change the location & formatting by amending the code below.
    It then removes the slide number from the 1st and last slides and if there's an Agenda slide that also.
    Hope it helps.

    ' Set up a few variables
    Dim SlideCount As Integer
    Dim NumSlide As Integer
    Dim SkipNumSlides As Integer
    Dim Transparancy as string
    Dim SlideNumLeft, SlideNumTop, SlideNumWidth, SlideNumHeight as Long
    ' Get the number of slides
    SlideCount = ActivePresentation.Slides.Count
    ' Check to see if an "Agenda" Slide Exists; if it does No Page Number
    Dim SL As Slide
        For Each SL In ActivePresentation.Slides
            If = "Agenda" Then
                    SkipNumSlides = 2
                    GoTo SkipNumSlidesSet
                    SkipNumSlides = 1
            End If
        Next SL
    ' Insert the Slide Numbers
        For NumSlide = 1 To SlideCount
            ActiveWindow.View.GotoSlide NumSlide
                    Set NewShape = ActivePresentation.Slides(NumSlide).Shapes.AddTextbox(msoTextOrientationHorizontal, SlideNumLeft, SlideNumTop, SlideNumWidth, SlideNumHeight)
                    With NewShape
                        .name = "MySlideNum" & NumSlide
                        .TextFrame.WordWrap = msoTrue
                        If Transparancy = "TRUE" Then
                            .Fill.Visible = msoFalse
                            With .Line
                                .Visible = vLineShow
                                .ForeColor.RGB = RGB(0,0,0)
                                .Weight = vLineWeight
                            End With
                            .Fill.Visible = msoTrue
                            .Fill.ForeColor.RGB = RGB(0,0,0))
                        End If
                        With .TextFrame.TextRange.ParagraphFormat
                            .LineRuleWithin = msoTrue
                            .SpaceWithin = 1
                            .LineRuleBefore = msoTrue
                            .SpaceBefore = 0.5
                            .LineRuleAfter = msoTrue
                            .SpaceAfter = 0
                        End With
                        With .TextFrame.TextRange
                            .Text = NumSlide - SkipNumSlides
                        End With
                        With .TextFrame.TextRange.Font
                        .Color = RGB(0,0,0)
                        .name = vFontName
                        .Bold = vFontBold
                        .Italic = vFontItalic
                        .Underline = vFontUnderline
                        .Size = vFontSize
                        End With
                    End With    ' shape
           Next NumSlide
    ' Remove the Slide Number if it Exists On The Title Slide (1)
    Dim GetNumber As Shape
        For Each GetNumber In ActivePresentation.Slides(1).Shapes
            If InStr(1,, "MySlideNum") > 0 Then
            End If
    ' Check to see if Agenda Slide Exists and if it does remove the Page Number
        For Each SL In ActivePresentation.Slides
            If = "Agenda" Then
                For Each sh In ActivePresentation.Slides("Agenda").Shapes
                   If InStr(1,, "MySlideNum") > 0 Or InStr(1,, "Footer Placeholder") > 0 Or InStr(1,, "Date Placeholder") > 0 Then
                   End If
            End If
        Next SL
    ' Remove the Slide Number if it Exists On The Last Slide 
    Dim GetLastSlide As Integer
    GetLastSlide = ActivePresentation.Slides.Count
    Dim GetNumberTextbox As Shape
        For Each GetNumberTextbox In ActivePresentation.Slides(GetLastSlide).Shapes
            If InStr(1,, "MySlideNum") > 0 Then
            End If

    Open in new window

    LVL 1

    Author Closing Comment


    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Join & Write a Comment

    People often ask "How do I make this macro run every time I show a new slide or add a new slide etc." This means making PowerPoint respond to that EVENT and, unlike in Excel, it's not that easy! First, I would avoid using the pseudo events left o…
    Outline From PowerPoint 2010 it is possible to have shapes appear in front of video, in earlier versions video always played in front of other shapes. This means it is possible to have captions animated to appear in front of video. Users who h…
    The viewer will learn how to edit the master slide. They will also learn how to combine multiple themes into one master slide to use them in their presentation.
    The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

    731 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    16 Experts available now in Live!

    Get 1:1 Help Now