问题
I'm trying to create a powerpoint presentation which will show the number of days since an injury in the workplace.
When the presentation is first opened by the user i'd like a macro to run that prompts for a date to be entered since the last injury. So far for that i have this which appears to work ok:-
Sub EveryDayAccidents()
Dim injdate As String
Dim lastdate As String
Dim injfree As Integer
Dim BnrMsg As String
'This Macro defines the latest injury date
injdate = InputBox("Please enter last injury date in this format: dd/mm/yyyy")
lastdate = injdate
injfree = DateDiff("d", injdate, Now)
BnrMsg = injfree
ActivePresentation.Slides(3).Shapes("Accidents").TextFrame.TextRange = BnrMsg
End Sub
What i'm missing is some code or another sub that will call this code when the presentation is opened.
Will the text box then update when the date changes naturally or will something need to be running in the background to update the text box? The plan is to leave the slides in the presentation running in a loop until an accident occurs then it would be reset and start again.
Any help would be much appreciated!!
EDIT
So now i have this:-
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
If SSW.View.CurrentShowPosition = 3 Then
injdate = ActivePresentation.Slides(3).Shapes("Accidents").TextFrame.TextRange
injfree = DateDiff("d", injdate, Now)
BnrMsg = injfree
ActivePresentation.Slides(3).Shapes("Accidents").TextFrame.TextRange = BnrMsg
End If
End Sub
Which does update the slide when the presentation is running... But it is treating the number in the text box as an actual date (65 turns into 05/03/1900) which means my date difference is in the region of 41,600... What i'd like to do is ignore the dates completely for a moment.
If i input a number (say 1) into the text box i would then want that number to increment by 1 each day, i think this code will do that anyway at the moment but i'm lacking the skills to convert :-
injfree = DateDiff("d", injdate, Now)
Into
injfree = injfree + 1 when date changes (garbage i know)
Please help :)
回答1:
Soooooo!!! Many thanks to @David Zemens and @Steve Ringsberg firstly!
I've managed to come up with a solution which might help someone else in the future so here is the final result. The up side of this is that no addins were required or anything else and it turns out the anwser is quite simple in the end...
For each slide that i wanted to do this on i have the following code in seperate modules to keep things clear, the only differences are the variables, slide numbers and Text Box names.
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
If SSW.View.CurrentShowPosition = 2 Then
actdate = ActivePresentation.Slides(2).Shapes("Last Prod").TextFrame.TextRange
injfree = DateDiff("d", actdate, Now)
BnrMsg = injfree
ActivePresentation.Slides(2).Shapes("Activity").TextFrame.TextRange = BnrMsg
End If
End Sub
What this code is doing is that as the presentation runs when the current position of the presentation reaches slide 2,3 etc it will then run the code attached to that slide. Here i used a small text box that isn't actually on the slide and put a starting date in. The code then names that date as 'actdate' then finds the difference between that date and the current date, then updates the second text box on the slide to show the difference value.
So if 'Last Prod' (textbox) = 01/01/2014 and the current date was 02/01/2014 then 'Activity' (textbox) = 1
Dead simple really :)
回答2:
What David said. But if you don't mind having the user click a button on the first slide to start the slide show, you can have that button fire a macro advances the show to slide 2 after first running your "Enter a date" code.
If the show autoruns, you can probably make use of an oddball event that doesn't require an add-in or event handler. Examples from Chirag Dalal here:
http://officeone.mvps.org/vba/run_macro_at_slide.html
回答3:
There is some great information HERE about making PowerPoint respond to events, however the caveat is unfortunately:
An Event handler cannot be set automatically. To set an event handler when PowerPoint starts up you still need to rely on the Auto_Open macro of an add-in to instantiate the event handler.
I am not sure if that is a suitable solution for your needs. Working with PPT Add-Ins is kind of a pain in the butt.
The code for the Add-In (untested, but copied mostly from existing Add-In that I have used) should be something like this, in an ordinary module, include the Auto_Open routine, your EveryDayAccidents routine (NOTE I modified it with some error-trapping), and two more (TrapEvents and ReleaseTrap) required by the event handler:
Option Explicit
'#################
'Creates a new class object from cEventClass module
Public cPPTObject As New cEventClass
Public TrapFlag As Boolean
'Public TrapFlag As Boolean
Sub Auto_Open()
'Call on the TrapEvents to instantiate the event handler
MsgBox "Auto_Open"
TrapEvents
End Sub
Sub TrapEvents()
If TrapFlag = True Then
MsgBox "Relax, my friend, the EventHandler is already active.", vbInformation + vbOKOnly, "PowerPoint Event Handler Example"
Exit Sub
End If
'## Instantiate our class object event handler
Set cPPTObject.PPTEvent = Application
TrapFlag = True
End Sub
Sub ReleaseTrap()
If TrapFlag = True Then
Set cPPTObject.PPTEvent = Nothing
Set cPPTObject = Nothing
TrapFlag = False
End If
End Sub
Sub EveryDayAccidents()
Dim injdate As String
Dim lastdate As String
Dim injfree As Integer
Dim BnrMsg As String
'This Macro defines the latest injury date
injdate = InputBox("Please enter last injury date in this format: dd/mm/yyyy")
lastdate = injdate
On Error GoTo InvalidDate
injfree = DateDiff("d", CDate(injdate), Now)
On Error GoTo 0
BnrMsg = injfree
ActivePresentation.Slides(3).Shapes("Accidents").TextFrame.TextRange = BnrMsg
Exit Sub
InvalidDate:
If MsgBox("You have entered an invalid date, try again?", vbOKCancel, "Invalid Date!") = vbOK Then
Err.Clear
GoTo Retry
End If
End Sub
Then, also create a class module named cEventClass, and in that module put the following code:
Option Explicit
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_PresentationOpen(ByVal Pres As Presentation)
'## Only run it on a particular filename:
'## Modify this line to reflect the presentation you need to run this on.
If Pres.Name = "MyPresentation.pptx" Then
'Call your procedure:
EveryDayAccidents
End If
End Sub
You will need to save as PPAM file type, and install the add-in. After the add-in is installed, PPTEvent_PresentationOpen will run every time the user opens a PPT file, and will call the procedure EveryDayAccidents if the filename is correct.
The Add-in file then becomes read-only, and you will not be able to debug errors in it without making a registry hack (google it). You will never be able to "Save As" from the PPAM file so I recommend always keeping a copy of PPTM version that you can use to debug, if needed. Any user expected to open this file will need to have the add-in installed for it to work as expected. so, like I said, working with Add-Ins is kind of a pain in the butt in PowerPoint and developing/debugging them is a fairly advanced exercise.
Good luck!
As for the remainder of your questions:
Will the text box then update when the date changes naturally
No. Do you mean "Would it prompt the user for input at regularly scheduled intervals?" If so, you could probably use windows task scheduler, or maybe Application.OnTime to run the routine at specific intervals.
will something need to be running in the background to update the text box?
Something will need to be running in the background, either task scheduler or the presentation running with an Application.OnTime assignment.
来源：https://stackoverflow.com/questions/22964263/vba-powerpoint-auto-run-on-open-and-run-in-the-background