Set current workday date -1 [PowerPoint 2016]

[Rob2308]

Hi guys,

I can't figure out how to write a powerpoint marco about yesterdays date. I have a ppt about yesterdays KPIs and I want to achieve the following:

- Select the existing text box that always shows a "date" and update it to yesterday's date, unless the current day is a monday, then it should be updated to last friday. The format "day, dd.mm.yyyy" should be used.
- it would be perfect if the macro starts the moment I open the ppt or save it but if this is not possible, it would be great if i could update it by clicking on a "button"
- the text box should appear on every slide of my ppt

I would really appreaciate your help.

Cheers,
Rob

[John Wilson]

Not easy to do because it is tricky to make this happen on open (unless you can write XML) and also the date header/footer acts in strange ways.

See if this gets you closer


Sub Yesterday()
Dim ocl As CustomLayout
Dim osld As Slide
Dim strdate As String


Select Case WeekdayName(Weekday(Now))
Case "Monday"
strdate = Now - 3
Case Else
strdate = Now - 1
End Select
strdate = Format(strdate, "dddd,dd/mm/yyyy")


For Each ocl In ActivePresentation.Designs(1).SlideMaster.CustomLayouts
ocl.HeadersFooters.DateAndTime.Text = strdate
Next ocl


For Each osld In ActivePresentation.Slides
osld.HeadersFooters.DateAndTime.Visible = True
osld.HeadersFooters.DateAndTime.Text = strdate
Next osld


End Sub

[Rob2308]

Hi John,

first of all thanks! This helps me a lot.:thumb


Not easy to do because it is tricky to make this happen on open (unless you can write XML) and also the date header/footer acts in strange ways.

See if this gets you closer


Sub Yesterday()
Dim ocl As CustomLayout
Dim osld As Slide
Dim strdate As String


Select Case WeekdayName(Weekday(Now))
Case "Monday"
strdate = Now - 3
Case Else
strdate = Now - 1
End Select
strdate = Format(strdate, "dddd,dd/mm/yyyy")


For Each ocl In ActivePresentation.Designs(1).SlideMaster.CustomLayouts
ocl.HeadersFooters.DateAndTime.Text = strdate
Next ocl


For Each osld In ActivePresentation.Slides
osld.HeadersFooters.DateAndTime.Visible = True
osld.HeadersFooters.DateAndTime.Text = strdate
Next osld


End Sub

But to be honest, it doesnt work for Mondays. Today, it says "Sunday, 16.08.2020" but its supposed to be "Friday, 14.08.2020". If I change Monday to Tuesday, it says "Friday,14.08.2020" :bug: Do I have to adjust the code in any way? :think:

[John Wilson]

Looks like you have Monday set as the first day of the month (instead on Sunday which is normal here)

Try changing this line


Select Case WeekdayName(Weekday(Now, FirstDayOfWeek:=vbSunday))

[Rob2308]

Thanks! :thumb This works perfectly :) May I ask you an additional question? I've added an autorun and autosave button to the presentation. So far it works but it saves the file with the current date, not the one I've "changed" within the presentation. Is there a way to change that as well?

Sub Auto_Open()
Call Date
ActivePresentation.SlideShowWindow.View.Exit
ActivePresentation.SaveAs ("C:\Users\Test\Desktop\Test" & "KIP-Board-" & Format(Now(), "DDDD,DD-MM-YYYY" & ".ppt"))

End Sub

Sub Date()
Dim ocl As CustomLayout
Dim osld As Slide
Dim strdate As String

Select Case WeekdayName(Weekday(Now, FirstDayOfWeek:=vbSunday))
Case "Monday"
strdate = Now - 3
Case Else
strdate = Now - 1
End Select
strdate = Format(strdate, "dddd,dd/mm/yyyy")

For Each ocl In ActivePresentation.Designs(1).SlideMaster.CustomLayouts
ocl.HeadersFooters.DateAndTime.Text = strdate
Next ocl

For Each osld In ActivePresentation.Slides
osld.HeadersFooters.DateAndTime.Visible = True
osld.HeadersFooters.DateAndTime.Text = strdate
Next osld
End Sub