Consulting

Results 1 to 5 of 5

Thread: Set current workday date -1 [PowerPoint 2016]

  1. #1
    VBAX Newbie
    Joined
    Aug 2020
    Posts
    3
    Location

    Set current workday date -1 [PowerPoint 2016]

    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
    Last edited by Rob2308; 08-17-2020 at 06:11 AM.

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Newbie
    Joined
    Aug 2020
    Posts
    3
    Location
    Hi John,

    first of all thanks! This helps me a lot.

    Quote Originally Posted by John Wilson View Post
    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" Do I have to adjust the code in any way?

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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))
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  5. #5
    VBAX Newbie
    Joined
    Aug 2020
    Posts
    3
    Location
    Thanks! 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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •