PDA

View Full Version : VBA to resize font in headers and body



rwc1023
07-14-2021, 07:02 AM
Hello - i hope someone can help me to update the codes below to do the resize correctly. I am trying to resize the font of any header and then the body/content as well as on the1st slide. based on my codes below, whenever the size of the font changes in the deck, the codes don't work correctly. Basically i need three separate VBA to do the work. see my codes below. hoping an expert can help!! thank you so much!!: pray2:


1. Change Header font size on every slide to 44

Sub ChangeHeaderFontSize()
Dim sld As Slide
Dim shp As Shape

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame = True Then
If shp.TextFrame.HasText = True Then
If shp.TextFrame.TextRange.Font.Size = 24 Then
shp.TextFrame.TextRange.Font.Size = 44

End If
End If
End If

Next
Next

End Sub


2. Change content font size of every slide to 32





Sub ChangeContentFontSize()
Dim sld As Slide
Dim shp As Shape

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame = True Then
If shp.TextFrame.HasText = True Then
If shp.TextFrame.TextRange.Font.Size = 15 Then
shp.TextFrame.TextRange.Font.Size = 32
End If
End If
End If

Next
Next

End Sub




3. Change header font size to 60 just on 1st Slide

Sub Change1stSlideHeaderFontSize()
Application.ActivePresentation.Slides(1) _
.Shapes(1).TextFrame.TextRange.Font _
.Size = 60

End Sub

Paul_Hossler
07-15-2021, 06:49 AM
This only does it on placeholders, not other types of shapes or tables

I didn't bother to test for the current font size (like in your macros)




Option Explicit


Sub test()
Dim oPres As Presentation
Dim oSlide As Slide
Dim oShape As Shape


Set oPres = ActivePresentation


For Each oSlide In oPres.Slides
For Each oShape In oSlide.Shapes
With oShape
If .Type <> msoPlaceholder Then GoTo NextShape
If Not .HasTextFrame Then GoTo NextShape
If Not .TextFrame.HasText Then GoTo NextShape

If (.PlaceholderFormat.Type = ppPlaceholderTitle) Or _
(.PlaceholderFormat.Type = ppPlaceholderCenterTitle) Or _
(.PlaceholderFormat.Type = ppPlaceholderVerticalTitle) Then
'3. Change header font size to 60 just on 1st Slide
'1. Change Header font size on every slide to 44
.TextFrame.TextRange.Font.Size = IIf(oSlide.SlideNumber = 1, 60, 44)

Else
'2. Change content font size of every slide to 32
.TextFrame.TextRange.Font.Size = 32
End If
End With

NextShape:
Next
NextSlide:
Next


End Sub

rwc1023
07-15-2021, 09:29 AM
Thank you Paul. It doesn't work well for the First Slide. How about we disregard the change to 1st slide and just VBA to change the font size of all content to 32, and change all header to 44 in all slides except the 1st slide? I tried to edit the codes you had and didn;t work. hope you can help. thank you!!!:bow:

Paul_Hossler
07-15-2021, 09:56 AM
Thank you Paul. It doesn't work well for the First Slide. How about we disregard the change to 1st slide and just VBA to change the font size of all content to 32, and change all header to 44 in all slides except the 1st slide? I tried to edit the codes you had and didn;t work. hope you can help. thank you!!!:bow:

We can do that, but it worked for me as far as the first slide

Attach a small presentation where it doesn't work