Display Date Difference

[erweinstein7]

Hi all,

I'm extremely new to VBA, so I'm just starting to understand a bit about the code. Basically what I want is to display a total number of safe working days in a box in the corner of a PowerPoint presentation - something like "There have been 25 safe working days in a row!" So I know I'll want the DateDiff formula using a difference between the current day and the last day of an accident. Any help getting this to be displayed in a shape would be greatly appreciated. Thanks so much.

[John Wilson]

This is the basis of the code

Sub Days_Since()
Dim startDate As Date
Dim daysElapsed As Long
Dim strMessage As String
On Error Resume Next
ActivePresentation.Slides(1).Shapes("TextMessage").Delete
startDate = #1/1/2013#
daysElapsed = dateDiff("d", startDate, Now)
strMessage = daysElapsed & " days since 1st January"
With ActivePresentation.Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientatio nHorizontal, _
Left:=500, Top:=500, Width:=200, Height:=12)
.TextFrame.TextRange = strMessage
.Name = "TextMessage"
End With
End Sub

Auto updating will be problematic though

[erweinstein7]

Hey John,

Thanks for the quick response. I ended up figuring out this code last night, which puts just the number in the box on the right:

Sub DateCounter()
Dim d As Date
d = DateValue("February 10, 2013") ' Converts to a date.
ActiveWindow.Selection.ShapeRange(1).TextFrame.TextRange.Text = DateDiff("d", #2/2/2013#, Now)
End Sub

Which results in something looking like this:

*I can't post links yet, but it is from imgur, so after the .com is "/JoqMrPP"

But when I changed my date on my computer to see if it would change, it didn't. Is this what you mean by auto-updating? I figured that just meant the presentation would have to be closed and then opened again to get the new number of "safe days".

Any help you could give is much appreciated.

- Eric

[John Wilson]

There's no simple way in PPt to make the code run automatically. You would need make a n AddIn that ran the code every time the slide changed or the presentation opened. You cannot do this with simple code.

[erweinstein7]

I found something about using XML and an onLoad command to get macros to run when the presentation is open.

From the site: pptalchemy.co.uk/PowerPoint_Auto_Open_Code.html

"This simply means that onLoad the code in the sub OnLoadCode will run. Be careful with upper and lower case - it matters! The code will only run if macro security is set low enough.
Note that onLoad refers to the RIBBON onLoad event not the presentation load event. If there is no ribbon the event will not fire. Opening a .ppsm file direct to show mode will NOT fire the event because the ribbon does not load."

I'm just not sure what it means to have "code in the sub OnLoadCode" but it seems like this may be my solution. Any idea what this all means?

[John Wilson]

The page explains how to do this including the vba and XML code (I wrote the page so yes I know what it means!) Just follow the instructions adding your own vba and add the XML using the code and method provided.

[erweinstein7]

Hi again John,

I'm so close, but still having some troubles. Because my macro is set to run on an active selected object, I believe having my macro autorun using XML will not work (because nothing is selected when the PPT file opens). Would you have any ideas on how to rewrite the code so that the macro would autorun on a specified object?

Thanks again for all of your help, it is very much appreciated.

- Eric

[John Wilson]

You are correct nothing will be selected and the code will fail. I presume you want this to appear on all slides?

So, Add the shape to the large slide master (View > Slidemaster)
Open the Selection Pane (HomeTab > Selet > Selection Pane) and change the name of the shape to DateBox (or something else if you wish but then change the code to reflect the name)

Code

Sub DateCounter()
Dim dateStart As Date
dateStart = DateValue("February 10, 2013") ' Converts to a date.
ActivePresentation.SlideMaster.Shapes("DateBox").TextFrame.TextRange.Text = DateDiff("d", dateStart, Now) & " safe working days."
End Sub

I uploaded a quick demo (http://www.pptalchemy.co.uk/Downloads/Autodate.pptm)