I would like to put the slides number AND the total number of slides in all of them. Something like: 1/60.
Is there a way I may do that?
To just put slide 1 is peace of cake but and what about putting "/60"?
:banghead:
Printable View
I would like to put the slides number AND the total number of slides in all of them. Something like: 1/60.
Is there a way I may do that?
To just put slide 1 is peace of cake but and what about putting "/60"?
:banghead:
Like this?
[vba]
Dim n As Long
Dim i As Long
n = ActivePresentation.Slides.Count
For i = 1 To n
ActivePresentation.Slides(i).Shapes(1).TextFrame.TextRange.Text = _
"Page " & i & " of " & n
Next i
[/vba]
Great Jacob,
it almost worked but its getting the number in the shape1. I need it at the bottom right.
This should be closer to what you want.
[vba]
Dim n As Long
Dim i As Long
n = ActivePresentation.Slides.Count
For i = 1 To n
With ActivePresentation.Slides(i).HeadersFooters
.Footer.Text = "Page " & i & " of " & n
.SlideNumber.Visible = msoFalse
End With
Next i
[/vba]
Hi Jacob,
not yet. The footer didnt appear. Anyway I found a solution. Not the ideal, but it works.
It is:
[VBA]
Sub Macro1()
On Error Resume Next
Dim n As Long
n = ActivePresentation.Slides.Count
ActiveWindow.ViewType = ppViewTitleMaster
ActivePresentation.TitleMaster.Shapes("Rectangle 6").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=5, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "/" & n
With .Font
.Name = "Arial"
.Size = 14
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(Red:=94, Green:=87, Blue:=78)
End With
End With
ActiveWindow.Selection.Unselect
ActiveWindow.ViewType = ppViewSlide
If ActivePresentation.HasTitleMaster Then
With ActivePresentation.TitleMaster.HeadersFooters
With .DateAndTime
.Format = ppDateTimeMdyy
.Text = ""
.UseFormat = msoFalse
.Visible = msoFalse
End With
.Footer.Visible = msoFalse
.SlideNumber.Visible = msoTrue
End With
End If
With ActivePresentation.SlideMaster.HeadersFooters
With .DateAndTime
.Format = ppDateTimeMdyy
.Text = ""
.UseFormat = msoFalse
.Visible = msoFalse
End With
.Footer.Visible = msoFalse
.SlideNumber.Visible = msoTrue
End With
With ActivePresentation.Slides.Range.HeadersFooters
With .DateAndTime
.Format = ppDateTimeMdyy
.Text = ""
.UseFormat = msoFalse
.Visible = msoFalse
End With
.Footer.Visible = msoFalse
.SlideNumber.Visible = msoTrue
End With
ActiveWindow.View.GotoSlide Index:=2
ActiveWindow.SmallScroll Down:=1
ActiveWindow.View.GotoSlide Index:=2
ActiveWindow.SmallScroll Down:=-1
ActiveWindow.View.GotoSlide Index:=2
ActiveWindow.SmallScroll Down:=1
ActiveWindow.View.GotoSlide Index:=3
ActiveWindow.ViewType = ppViewSlideMaster
ActivePresentation.SlideMaster.Shapes("Rectangle 6").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=5, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "/" & n
With .Font
.Name = "Arial"
.Size = 14
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppShadow
End With
End With
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.View.GotoSlide Index:=4
End Sub
[/VBA]
Thanks for the help anyway
It looks like all of that is not needed. Try this macro.
[vba]
Option Explicit
Sub Macro1()
With ActivePresentation.SlideMaster.HeadersFooters
With .DateAndTime
.Format = ppDateTimeMdyy
.Text = ""
.UseFormat = msoFalse
.Visible = msoFalse
End With
.Footer.Visible = msoFalse
.SlideNumber.Visible = msoTrue
End With
End Sub
[/vba]
Hi Jacob,
this time you have put only the slide number, but I still need to total.
Although I agree it needs a "lipo", I just didnt find which lines I could cut, :(.
Well so long as it works that is all that really matters. You can cut the lines that are just SmallScroll or GotoSlide etc.
Lines cutted! Thanks again!
Glad to help.
Take Care