Question

我试图创建一个powerpoint演示文稿，显示自工作场所受伤以来的天数。

当用户首次打开演示文稿时，我想要一个宏来运行，提示输入自上次受伤后输入的日期。到目前为止，我有这个似乎工作正常： -

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

我缺少的是在打开演示文稿时会调用此代码的一些代码或其他子代码。

当日期自然更改或者需要在后台运行某些内容以更新文本框时，文本框是否会更新？计划是让演示文稿中的幻灯片循环运行，直到发生事故，然后重置并重新开始。

任何帮助都将非常感谢!!

修改

现在我有了这个： -

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

当演示文稿正在运行时，它会更新幻灯片...但是它将文本框中的数字视为实际日期（65变成05/03/1900），这意味着我的日期差异在以下区域： 41,600 ......我想做的就是暂时忽略日期。

如果我在文本框中输入一个数字（比如1），那么我希望这个数字每天增加1，我认为此代码目前仍会这样做但我缺乏技能转换： -

injfree = DateDiff("d", injdate, Now)

进入

injfree = injfree + 1 when date changes (garbage i know)

请帮助：）

Answer 1

Soooooo !!!非常感谢@David Zemens和@Steve Ringsberg！

我设法提出了一个可能在将来帮助其他人的解决方案，所以这是最终的结果。这方面的好处是不需要任何插件或其他任何东西，事实证明anwser最终很简单...

对于我想要执行此操作的每张幻灯片，我在单独的模块中有以下代码以保持清晰，唯一的区别是变量，幻灯片编号和文本框名称。

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

此代码正在执行的操作是，当演示文稿的当前位置达到幻灯片2,3等时，演示文稿将运行，然后它将运行附加到该幻灯片的代码。在这里，我使用了一个小文本框，它实际上并不在幻灯片上，而是将开始日期设置为。然后代码将该日期命名为＆＃39; actdate＆＃39;然后查找该日期与当前日期之间的差异，然后更新幻灯片上的第二个文本框以显示差异值。

所以如果＆＃39; Last Prod＆＃39; （文本框）= 01/01/2014，当前日期是02/01/2014然后＆＃39;活动＆＃39; （文本框）= 1

真的很简单：）

Answer 2

大卫说的话。但是，如果您不介意让用户点击第一张幻灯片上的按钮来开始幻灯片放映，您可以让该按钮触发一个宏，在首次运行＆＃34之后将节目推进到幻灯片2;输入日期＆＃34;代码。

如果show autoruns，你可以使用一个不需要加载项或事件处理程序的古怪事件。来自Chirag Dalal的例子：

http://officeone.mvps.org/vba/run_macro_at_slide.html

Answer 3

关于让PowerPoint回应事件，有一些很好的信息HERE，不过遗憾的是：

无法自动设置事件处理程序。要在PowerPoint启动时设置事件处理程序，您仍然需要依赖加载项的Auto_Open宏来实例化事件处理程序。

我不确定这是否适合您的需求。使用PPT插件是一种痛苦的屁股。

加载项的代码（未经测试，但主要是从我使用的现有加载项中复制的）应该是这样的，在普通模块中，包括Auto_Open例程，你的{{1例程（注意我用一些错误捕获修改了它），以及事件处理程序所需的另外两个（EveryDayAccidents和TrapEvents）：

ReleaseTrap

然后，还要创建一个名为 cEventClass 的类模块，并在该模块中输入以下代码：

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

您需要另存为PPAM文件类型，然后安装加载项。安装加载项后，每次用户打开PPT文件时都会运行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，如果文件名正确，将调用过程PPTEvent_PresentationOpen。

然后，加载项文件变为只读，如果不进行注册表攻击（google），您将无法在其中调试错误。您永远无法从PPAM文件中“另存为”，因此我建议您始终保留可用于调试的PPTM版本的副本（如果需要）。任何希望打开此文件的用户都需要安装加载项才能按预期工作。所以，就像我说的那样，使用Add-Ins是PowerPoint中的一个痛点，开发/调试它们是一个相当高级的练习。

祝你好运！

关于你的其余问题：

当日期自然变化时，文本框是否会更新

没有。你的意思是“它是否会定期提示用户输入？”如果是这样，您可以使用Windows任务计划程序，或者EveryDayAccidents可以按特定时间间隔运行例程。

是否需要在后台运行才能更新文本框？

需要在后台运行某些内容，无论是任务计划程序还是使用Application.OnTime作业运行的演示文稿。

VBA Powerpoint - 自动在打开时运行并在后台运行

3 个答案: