Writing Macros in PPT

Hi,
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.
LVL 1
PiyusKantiAsked:
Who is Participating?
 
GemstormConnect With a Mentor Commented:
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 SL.name = "Agenda" Then
                SkipNumSlides = 2
                GoTo SkipNumSlidesSet
            Else
                SkipNumSlides = 1
        End If
    Next SL

SkipNumSlidesSet:

' 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
                    Else
                        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, GetNumber.name, "MySlideNum") > 0 Then
            ActivePresentation.Slides(1).Shapes(GetNumber.name).Delete
        End If
    Next

' Check to see if Agenda Slide Exists and if it does remove the Page Number
    For Each SL In ActivePresentation.Slides
        If SL.name = "Agenda" Then
            For Each sh In ActivePresentation.Slides("Agenda").Shapes
               If InStr(1, sh.name, "MySlideNum") > 0 Or InStr(1, sh.name, "Footer Placeholder") > 0 Or InStr(1, sh.name, "Date Placeholder") > 0 Then
                 ActivePresentation.Slides("Agenda").Shapes(sh.name).Delete
               End If
            Next
        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, GetNumberTextbox.name, "MySlideNum") > 0 Then
            ActivePresentation.Slides(GetLastSlide).Shapes(GetNumberTextbox.name).Delete
        End If
    Next

Open in new window

0
 
JSRWilsonCommented:
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
OR
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
0
 
PiyusKantiAuthor Commented:
Hi,

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.
Also,
I am  using the title only layout and have added five normal textboxes to each slide.

Please, provide me with the ncessary code.

Thanks
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
JSRWilsonCommented:
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

0
 
PiyusKantiAuthor Commented:
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.
Thx
0
 
PiyusKantiAuthor Commented:
na
0
All Courses

From novice to tech pro — start learning today.