Change font size and colour in footer through VBA

Hi,

I am using the code below to transfer data from an Access 2003 table to be
displayed in PowerPoint.

Currently, it displays a footer, along with the date and slide number. How
do I go about adjusting the font size and colour of the text in the footer?

(Sorry about the line breaks)

Thanks,
Anthony


My Code here:
***********
Dim PPApp As Object 'late binding
Dim PPPres As Object
Dim PPSlide As Object
Dim db As Database, rs As Recordset
Dim strSql As String

Set PPApp = GetObject(, "PowerPoint.Application")

If PPApp Is Nothing Then 'no existing application is running
Set PPApp = CreateObject("PowerPoint.Application")
End If

If PPApp Is Nothing Then 'not able to create the application
MsgBox "The application is not available!",
vbExclamation+vbOKOnly,"Help."
End If

'Open up a recordset on the employee table.
Set db = CurrentDb
strSql = "SELECT * From [Employee] WHERE (Status = True);"
Set rs = db.OpenRecordset(strSql)
Set PPPres = PPApp.Presentations.Add
With PPApp
While Not rs.EOF
With PPPres.Slides
Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
PPSlide.HeadersFooters.Footer.Visible = True
PPSlide.HeadersFooters.Footer.Text = "My Footer Text Here."
PPSlide.HeadersFooters.DateAndTime.Visible = True
PPSlide.HeadersFooters.DateAndTime.UseFormat = True
PPSlide.HeadersFooters.DateAndTime.Format = 1
PPSlide.HeadersFooters.SlideNumber.Visible = True

PPSlide.Shapes(1).TextFrame.TextRange.Text =
UCase(CStr(rs.Fields("EmployeeID").value))

PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
" & CStr(rs.Fields("FirstName").value) & vbCrLf & _
"Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf & _
"Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
"Level = " & CStr(rs.Fields("Level").value)


PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30

PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size = 26

PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
vbBlue

End With

rs.MoveNext

Wend

End With

PPPres.SlideShowSettings.Run

Set PPApp = Nothing
Set PPSlide = Nothing
Set PPPres = Nothing

End If

End If

vindys
Wed May 07 05:38:01 CDT 2008

Hi Anthony,

I doubt if you have any option to change color and size of footer using VBA
as its not provided using powerpoint

Thanks,
Vindys

"BigAnthony" wrote:

> Hi,
>
> I am using the code below to transfer data from an Access 2003 table to be
> displayed in PowerPoint.
>
> Currently, it displays a footer, along with the date and slide number. How
> do I go about adjusting the font size and colour of the text in the footer?
>
> (Sorry about the line breaks)
>
> Thanks,
> Anthony
>
>
> My Code here:
> ***********
> Dim PPApp As Object 'late binding
> Dim PPPres As Object
> Dim PPSlide As Object
> Dim db As Database, rs As Recordset
> Dim strSql As String
>
> Set PPApp = GetObject(, "PowerPoint.Application")
>
> If PPApp Is Nothing Then 'no existing application is running
> Set PPApp = CreateObject("PowerPoint.Application")
> End If
>
> If PPApp Is Nothing Then 'not able to create the application
> MsgBox "The application is not available!",
> vbExclamation+vbOKOnly,"Help."
> End If
>
> 'Open up a recordset on the employee table.
> Set db = CurrentDb
> strSql = "SELECT * From [Employee] WHERE (Status = True);"
> Set rs = db.OpenRecordset(strSql)
> Set PPPres = PPApp.Presentations.Add
> With PPApp
> While Not rs.EOF
> With PPPres.Slides
> Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
> PPSlide.HeadersFooters.Footer.Visible = True
> PPSlide.HeadersFooters.Footer.Text = "My Footer Text Here."
> PPSlide.HeadersFooters.DateAndTime.Visible = True
> PPSlide.HeadersFooters.DateAndTime.UseFormat = True
> PPSlide.HeadersFooters.DateAndTime.Format = 1
> PPSlide.HeadersFooters.SlideNumber.Visible = True
>
> PPSlide.Shapes(1).TextFrame.TextRange.Text =
> UCase(CStr(rs.Fields("EmployeeID").value))
>
> PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
> " & CStr(rs.Fields("FirstName").value) & vbCrLf & _
> "Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf & _
> "Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
> "Level = " & CStr(rs.Fields("Level").value)
>
>
> PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
>
> PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size = 26
>
> PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
> vbBlue
>
> End With
>
> rs.MoveNext
>
> Wend
>
> End With
>
> PPPres.SlideShowSettings.Run
>
> Set PPApp = Nothing
> Set PPSlide = Nothing
> Set PPPres = Nothing
>
> End If
>
> End If
>

Chirag
Wed May 07 07:11:39 CDT 2008

In Slide Master, look for shapes of type Placeholder. Footer is a
Placeholder of type ppPlaceholderFooter. You can look for it in
PlaceholderFormat.Type property.

- Chirag

PowerShow - View multiple PowerPoint slide shows simultaneously
http://officeone.mvps.org/powershow/powershow.html

"BigAnthony" <BigAnthony@discussions.microsoft.com> wrote in message
news:0380B625-A620-44E1-BA4D-B6DA687FC9AB@microsoft.com...
> Hi,
>
> I am using the code below to transfer data from an Access 2003 table to be
> displayed in PowerPoint.
>
> Currently, it displays a footer, along with the date and slide number. How
> do I go about adjusting the font size and colour of the text in the
> footer?
>
> (Sorry about the line breaks)
>
> Thanks,
> Anthony
>
>
> My Code here:
> ***********
> Dim PPApp As Object 'late binding
> Dim PPPres As Object
> Dim PPSlide As Object
> Dim db As Database, rs As Recordset
> Dim strSql As String
>
> Set PPApp = GetObject(, "PowerPoint.Application")
>
> If PPApp Is Nothing Then 'no existing application is running
> Set PPApp = CreateObject("PowerPoint.Application")
> End If
>
> If PPApp Is Nothing Then 'not able to create the application
> MsgBox "The application is not available!",
> vbExclamation+vbOKOnly,"Help."
> End If
>
> 'Open up a recordset on the employee table.
> Set db = CurrentDb
> strSql = "SELECT * From [Employee] WHERE (Status = True);"
> Set rs = db.OpenRecordset(strSql)
> Set PPPres = PPApp.Presentations.Add
> With PPApp
> While Not rs.EOF
> With PPPres.Slides
> Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
> PPSlide.HeadersFooters.Footer.Visible = True
> PPSlide.HeadersFooters.Footer.Text = "My Footer Text
> Here."
> PPSlide.HeadersFooters.DateAndTime.Visible = True
> PPSlide.HeadersFooters.DateAndTime.UseFormat = True
> PPSlide.HeadersFooters.DateAndTime.Format = 1
> PPSlide.HeadersFooters.SlideNumber.Visible = True
>
> PPSlide.Shapes(1).TextFrame.TextRange.Text =
> UCase(CStr(rs.Fields("EmployeeID").value))
>
> PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
> " & CStr(rs.Fields("FirstName").value) & vbCrLf & _
> "Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf
> & _
> "Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
> "Level = " & CStr(rs.Fields("Level").value)
>
>
> PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
>
> PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size = 26
>
> PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
> vbBlue
>
> End With
>
> rs.MoveNext
>
> Wend
>
> End With
>
> PPPres.SlideShowSettings.Run
>
> Set PPApp = Nothing
> Set PPSlide = Nothing
> Set PPPres = Nothing
>
> End If
>
> End If
>

BigAnthony
Thu May 08 01:44:00 CDT 2008

Chirag,

If it is possible, can you give me an example of the code I need?

I have adapted my code and it appears below.

Anthony



My Code here:
***********
Dim PPApp As Object 'late binding
Dim PPPres As Object
Dim PPSlide As Object
Dim mySlidesHF as object
Dim db As Database, rs As Recordset
Dim strSql As String

Set PPApp = GetObject(, "PowerPoint.Application")

If PPApp Is Nothing Then 'no existing application is running
Set PPApp = CreateObject("PowerPoint.Application")
End If

If PPApp Is Nothing Then 'not able to create the application
MsgBox "The application is not available!",
vbExclamation+vbOKOnly,"Help."
End If

'Open up a recordset on the employee table.
Set db = CurrentDb
strSql = "SELECT * From [Employee] WHERE (Status = True);"
Set rs = db.OpenRecordset(strSql)
Set PPPres = PPApp.Presentations.Add
With PPApp
Set mySlidesHF = PPPres.SlideMaster.HeadersFooters
With mySlidesHF
.Footer.Visible = True
.Footer.Text = "My Footer Here"
.SlideNumber.Visible = True
.DateAndTime.Visible = True
.DateAndTime.UseFormat = True
.DateAndTime.Format = 1
End With

While Not rs.EOF
With PPPres.Slides
Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)

PPSlide.Shapes(1).TextFrame.TextRange.Text =
UCase(CStr(rs.Fields("EmployeeID").value))

PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
" & CStr(rs.Fields("FirstName").value) & vbCrLf & _
"Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf & _
"Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
"Level = " & CStr(rs.Fields("Level").value)

PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size
= 30
PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size
= 26

PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
vbBlue

End With

rs.MoveNext

Wend

End With

PPPres.SlideShowSettings.Run

Set PPApp = Nothing
Set PPSlide = Nothing
Set PPPres = Nothing
Set mySlidesHF = Nothing

End If

End If




"Chirag" wrote:

> In Slide Master, look for shapes of type Placeholder. Footer is a
> Placeholder of type ppPlaceholderFooter. You can look for it in
> PlaceholderFormat.Type property.
>
> - Chirag
>
> PowerShow - View multiple PowerPoint slide shows simultaneously
> http://officeone.mvps.org/powershow/powershow.html
>
> "BigAnthony" <BigAnthony@discussions.microsoft.com> wrote in message
> news:0380B625-A620-44E1-BA4D-B6DA687FC9AB@microsoft.com...
> > Hi,
> >
> > I am using the code below to transfer data from an Access 2003 table to be
> > displayed in PowerPoint.
> >
> > Currently, it displays a footer, along with the date and slide number. How
> > do I go about adjusting the font size and colour of the text in the
> > footer?
> >
> > (Sorry about the line breaks)
> >
> > Thanks,
> > Anthony
> >
> >
> > My Code here:
> > ***********
> > Dim PPApp As Object 'late binding
> > Dim PPPres As Object
> > Dim PPSlide As Object
> > Dim db As Database, rs As Recordset
> > Dim strSql As String
> >
> > Set PPApp = GetObject(, "PowerPoint.Application")
> >
> > If PPApp Is Nothing Then 'no existing application is running
> > Set PPApp = CreateObject("PowerPoint.Application")
> > End If
> >
> > If PPApp Is Nothing Then 'not able to create the application
> > MsgBox "The application is not available!",
> > vbExclamation+vbOKOnly,"Help."
> > End If
> >
> > 'Open up a recordset on the employee table.
> > Set db = CurrentDb
> > strSql = "SELECT * From [Employee] WHERE (Status = True);"
> > Set rs = db.OpenRecordset(strSql)
> > Set PPPres = PPApp.Presentations.Add
> > With PPApp
> > While Not rs.EOF
> > With PPPres.Slides
> > Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
> > PPSlide.HeadersFooters.Footer.Visible = True
> > PPSlide.HeadersFooters.Footer.Text = "My Footer Text
> > Here."
> > PPSlide.HeadersFooters.DateAndTime.Visible = True
> > PPSlide.HeadersFooters.DateAndTime.UseFormat = True
> > PPSlide.HeadersFooters.DateAndTime.Format = 1
> > PPSlide.HeadersFooters.SlideNumber.Visible = True
> >
> > PPSlide.Shapes(1).TextFrame.TextRange.Text =
> > UCase(CStr(rs.Fields("EmployeeID").value))
> >
> > PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
> > " & CStr(rs.Fields("FirstName").value) & vbCrLf & _
> > "Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf
> > & _
> > "Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
> > "Level = " & CStr(rs.Fields("Level").value)
> >
> >
> > PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
> >
> > PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size = 26
> >
> > PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
> > vbBlue
> >
> > End With
> >
> > rs.MoveNext
> >
> > Wend
> >
> > End With
> >
> > PPPres.SlideShowSettings.Run
> >
> > Set PPApp = Nothing
> > Set PPSlide = Nothing
> > Set PPPres = Nothing
> >
> > End If
> >
> > End If
> >
>

john
Thu May 08 02:52:01 CDT 2008

Hi

I think Chiraq means you would need to look for the correct placeholder on
the master and then modify it. Something like this maybe

Dim oplc As Shape
For Each oplc In ActivePresentation.SlideMaster.Shapes
If oplc.Type = msoPlaceholder Then
If oplc.PlaceholderFormat.Type = ppPlaceholderFooter Then
With oplc.TextFrame.TextRange.Font
.Color = vbRed
.Size = 12
End With
End If
End If
Next oplc
--
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk


"BigAnthony" wrote:

> Chirag,
>
> If it is possible, can you give me an example of the code I need?
>
> I have adapted my code and it appears below.
>
> Anthony
>
>
>
> My Code here:
> ***********
> Dim PPApp As Object 'late binding
> Dim PPPres As Object
> Dim PPSlide As Object
> Dim mySlidesHF as object
> Dim db As Database, rs As Recordset
> Dim strSql As String
>
> Set PPApp = GetObject(, "PowerPoint.Application")
>
> If PPApp Is Nothing Then 'no existing application is running
> Set PPApp = CreateObject("PowerPoint.Application")
> End If
>
> If PPApp Is Nothing Then 'not able to create the application
> MsgBox "The application is not available!",
> vbExclamation+vbOKOnly,"Help."
> End If
>
> 'Open up a recordset on the employee table.
> Set db = CurrentDb
> strSql = "SELECT * From [Employee] WHERE (Status = True);"
> Set rs = db.OpenRecordset(strSql)
> Set PPPres = PPApp.Presentations.Add
> With PPApp
> Set mySlidesHF = PPPres.SlideMaster.HeadersFooters
> With mySlidesHF
> .Footer.Visible = True
> .Footer.Text = "My Footer Here"
> .SlideNumber.Visible = True
> .DateAndTime.Visible = True
> .DateAndTime.UseFormat = True
> .DateAndTime.Format = 1
> End With
>
> While Not rs.EOF
> With PPPres.Slides
> Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
>
> PPSlide.Shapes(1).TextFrame.TextRange.Text =
> UCase(CStr(rs.Fields("EmployeeID").value))
>
> PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
> " & CStr(rs.Fields("FirstName").value) & vbCrLf & _
> "Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf & _
> "Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
> "Level = " & CStr(rs.Fields("Level").value)
>
> PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size
> = 30
> PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size
> = 26
>
> PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
> vbBlue
>
> End With
>
> rs.MoveNext
>
> Wend
>
> End With
>
> PPPres.SlideShowSettings.Run
>
> Set PPApp = Nothing
> Set PPSlide = Nothing
> Set PPPres = Nothing
> Set mySlidesHF = Nothing
>
> End If
>
> End If
>
>
>
>
> "Chirag" wrote:
>
> > In Slide Master, look for shapes of type Placeholder. Footer is a
> > Placeholder of type ppPlaceholderFooter. You can look for it in
> > PlaceholderFormat.Type property.
> >
> > - Chirag
> >
> > PowerShow - View multiple PowerPoint slide shows simultaneously
> > http://officeone.mvps.org/powershow/powershow.html
> >
> > "BigAnthony" <BigAnthony@discussions.microsoft.com> wrote in message
> > news:0380B625-A620-44E1-BA4D-B6DA687FC9AB@microsoft.com...
> > > Hi,
> > >
> > > I am using the code below to transfer data from an Access 2003 table to be
> > > displayed in PowerPoint.
> > >
> > > Currently, it displays a footer, along with the date and slide number. How
> > > do I go about adjusting the font size and colour of the text in the
> > > footer?
> > >
> > > (Sorry about the line breaks)
> > >
> > > Thanks,
> > > Anthony
> > >
> > >
> > > My Code here:
> > > ***********
> > > Dim PPApp As Object 'late binding
> > > Dim PPPres As Object
> > > Dim PPSlide As Object
> > > Dim db As Database, rs As Recordset
> > > Dim strSql As String
> > >
> > > Set PPApp = GetObject(, "PowerPoint.Application")
> > >
> > > If PPApp Is Nothing Then 'no existing application is running
> > > Set PPApp = CreateObject("PowerPoint.Application")
> > > End If
> > >
> > > If PPApp Is Nothing Then 'not able to create the application
> > > MsgBox "The application is not available!",
> > > vbExclamation+vbOKOnly,"Help."
> > > End If
> > >
> > > 'Open up a recordset on the employee table.
> > > Set db = CurrentDb
> > > strSql = "SELECT * From [Employee] WHERE (Status = True);"
> > > Set rs = db.OpenRecordset(strSql)
> > > Set PPPres = PPApp.Presentations.Add
> > > With PPApp
> > > While Not rs.EOF
> > > With PPPres.Slides
> > > Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
> > > PPSlide.HeadersFooters.Footer.Visible = True
> > > PPSlide.HeadersFooters.Footer.Text = "My Footer Text
> > > Here."
> > > PPSlide.HeadersFooters.DateAndTime.Visible = True
> > > PPSlide.HeadersFooters.DateAndTime.UseFormat = True
> > > PPSlide.HeadersFooters.DateAndTime.Format = 1
> > > PPSlide.HeadersFooters.SlideNumber.Visible = True
> > >
> > > PPSlide.Shapes(1).TextFrame.TextRange.Text =
> > > UCase(CStr(rs.Fields("EmployeeID").value))
> > >
> > > PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
> > > " & CStr(rs.Fields("FirstName").value) & vbCrLf & _
> > > "Surname = " & CStr(rs.Fields("Surname").value)& vbCrLf
> > > & _
> > > "Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf & _
> > > "Level = " & CStr(rs.Fields("Level").value)
> > >
> > >
> > > PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
> > >
> > > PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size = 26
> > >
> > > PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color =
> > > vbBlue
> > >
> > > End With
> > >
> > > rs.MoveNext
> > >
> > > Wend
> > >
> > > End With
> > >
> > > PPPres.SlideShowSettings.Run
> > >
> > > Set PPApp = Nothing
> > > Set PPSlide = Nothing
> > > Set PPPres = Nothing
> > >
> > > End If
> > >
> > > End If
> > >
> >

biganthony
Thu May 08 04:33:07 CDT 2008

Hi John,

Thanks for the help. With your help and resources on the Web, I have been
able to do it.

This is what I have:


Set PPShape = PPApp.Shape

For Each PPShape In PPPres.SlideMaster.Shapes

If PPShape.Type = 14 Then

If PPShape.PlaceholderFormat.Type = 13 Or PPShape.
PlaceholderFormat.Type = 15 Or PPShape.PlaceholderFormat.Type = 16 Then

With PPShape.TextFrame.TextRange.Font
.Color = vbRed
.Size = 10
End With
End If

End If

Next PPShape

If you think I can refine the code above, I'd appreciate it.
Anthony


John Wilson wrote:
>Hi
>
>I think Chiraq means you would need to look for the correct placeholder on
>the master and then modify it. Something like this maybe
>
>Dim oplc As Shape
>For Each oplc In ActivePresentation.SlideMaster.Shapes
>If oplc.Type = msoPlaceholder Then
>If oplc.PlaceholderFormat.Type = ppPlaceholderFooter Then
>With oplc.TextFrame.TextRange.Font
>.Color = vbRed
>.Size = 12
>End With
>End If
>End If
>Next oplc
>> Chirag,
>>
>[quoted text clipped - 174 lines]
>> > >
>> > > End If

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/powerpoint/200805/1