Powerpoint-Presentation：在演示时捕获幻灯片和内部幻灯片动画的持续时间 [英] Powerpoint-Presentation: Capturing Durations of Slides and inner-slide Animations at Presentation-Time

问题描述

在片刻，我是VBA的新手，我需要提示我必须解决以下问题：
虽然PPT-（2007） - 演示文稿是在一个共同的实况中呈现的，但是后台的一个程序应记录每张幻灯片的持续时间及其内部幻灯片动画，并将其保存为简单的文本文件。 （该程序应该区分幻灯片中的幻灯片持续时间和动画持续时间，例如项目符号列表）所以最后这个文本文件包含演示者为每张幻灯片拍摄了多长时间以及他在内部部分保留多长时间，例如单独的动画项目符号列表。
您怎么看？VBA是解决这个问题的好选择吗？如果是的话：对新手的建议从哪里开始？

最好的问候，
亚当
在这里，我很高兴，

At the Moment i am new to VBA and i need hints for following Problem I have to solve:
While a PPT-(2007)-presentation is presented in a common live-situation, a programm in the background should log the durations of each slide and its inner-slide animations and save them to a simple textfile. (The programm should distinguish between slide-duration and animation duration within slides, e.g. bulleted lists)
So at the end this textfile contains just how long the presenter took for each slide and how long he remained at innersliede sections like separate animated bulleted lists.
What do you think - will VBA be a good choice to solve this problem? If yes: an suggestions for a rookie where to start?

Best regards,
Adam

Ich danke Euch schonmal im Voraus,

推荐答案

我们可以捕获电源点的事件，希望这个例子对你有用。

请通过以下步骤，

• 创建新的Power Point文件


• 添加名为"clsEvent"的新类


• 从工具参考中，设置 Microsoft Scripting Runtime的参考。


• 将代码粘贴到clsEvent类


• Option Explicit
  Public WithEvents PPTEvent As Application
  
  Private Sub PPTEvent_AfterNewPresentation（ByVal Pres As Presentation）
  Logger"After New Presentation" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_AfterPresentationOpen（ByVal Pres As Presentation）
  记录器"演示后"开放" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_ColorSchemeChanged（ByVal SldRange为SlideRange）
  记录器"配色方案"改变" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_NewPresentation（ByVal Pres As Presentation）
  记录器"新演示文稿" ; &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_PresentationBeforeSave（ByVal Pres As Presentation，Cancel As Boolean）
  记录器"保存前的演示文稿" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_PresentationClose（ByVal Pres As Presentation）
  记录器"演示关闭" ; &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_PresentationNewSlide（ByVal Sld As Slide）
  记录器"Presentation New滑动" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_PresentationOpen（ByVal Pres As Presentation）
  记录器"Presentation Open" ; &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_PresentationPrint（ByVal Pres As Presentation）
  记录器"演示文稿打印" ; &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_PresentationSave（ByVal Pres As Presentation）
  记录器"Presentation Save" ; &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私有子PPTEvent_PresentationSync（ByVal Pres As Presentation，ByVal SyncEventType As Office.MsoSyncEventType）结束子
  
  私有子PPTEvent_SlideSelectionChanged（ByVal SldRange为SlideRange）
  记录器"幻灯片选择"改变" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowBegin（ByVal Wn As SlideShowWindow）
  记录器"幻灯片放映"开始" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowEnd（ByVal Pres As Presentation）
  记录器"幻灯片放映"端" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowNextBuild（ByVal Wn As SlideShowWindow）
  记录器"幻灯片放映" Next Build" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowNextClick（ByVal Wn作为SlideShowWindow，ByVal nEffect As Effect）
  记录器"幻灯片放映下一步点击" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowNextSlide（ByVal Wn As SlideShowWindow）
  记录器"幻灯片放映"下一张幻灯片" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowOnNext（ByVal Wn As SlideShowWindow）
  记录器"幻灯片放映"在下一个" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_SlideShowOnPrevious（ByVal Wn As SlideShowWindow）
  记录器"幻灯片放映"在之前的" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_WindowActivate（ByVal Pres As Presentation，ByVal Wn As DocumentWindow）
  记录器"窗口激活" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_WindowBeforeDoubleClick（ByVal Sel As Selection，Cancel As Boolean）
  记录器"双击之前的窗口" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_WindowBeforeRightClick（ByVal Sel As Selection，Cancel As Boolean）
  记录器"右键单击前窗口" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_WindowDeactivate（ByVal Pres As Presentation，ByVal Wn As DocumentWindow）
  记录器"窗口停用" &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束子
  
  私人子PPTEvent_WindowSelectionChange（ByVal Sel As Selection）
  记录器"窗口选择"变化与QUOT; &安培; vbTab&格式（现在，"dd-MMM-yyyy hh：mm：ss"）
  结束次要


• 创建名为"Module1"的新模块


• 粘贴代码


• 选项显式
  Const iLogFilePath =" c：\ LogFiles"
  Dim cPPTObject As new clsEvent
  
  Sub SetPPT（）
  设置cPPTObject.PPTEvent =应用
  结束Sub
  
  Sub Logger （strLogDetails As String）
  ''''''''''''''''''''''''''''''''''''''''''''''''''' Dim iLogFileName

We can capture the events of power point,
Hope this example will be useful to you.

please go through below steps,

• Create New Power point File
• add New Class Named "clsEvent"
• From Tools reference, set reference for Microsoft Scripting Runtime.
• Paste Below code into clsEvent Class
• Option Explicit
  Public WithEvents PPTEvent As Application
  
  Private Sub PPTEvent_AfterNewPresentation(ByVal Pres As Presentation)
      Logger "After New Presentation" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_AfterPresentationOpen(ByVal Pres As Presentation)
      Logger "After Presentation Open" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_ColorSchemeChanged(ByVal SldRange As SlideRange)
      Logger "Color Scheme Changed" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_NewPresentation(ByVal Pres As Presentation)
      Logger "New Presentation" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)
      Logger "Presentation Before Save" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationClose(ByVal Pres As Presentation)
      Logger "Presentation Close" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationNewSlide(ByVal Sld As Slide)
      Logger "Presentation New Slide" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationOpen(ByVal Pres As Presentation)
      Logger "Presentation Open" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationPrint(ByVal Pres As Presentation)
      Logger "Presentation Print" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationSave(ByVal Pres As Presentation)
      Logger "Presentation Save" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_PresentationSync(ByVal Pres As Presentation, ByVal SyncEventType As Office.MsoSyncEventType)
      Logger "Presentation Sync" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideSelectionChanged(ByVal SldRange As SlideRange)
      Logger "Slide Selection Changed" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowBegin(ByVal Wn As SlideShowWindow)
      Logger "Slide Show Begin" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowEnd(ByVal Pres As Presentation)
      Logger "Slide Show End" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowNextBuild(ByVal Wn As SlideShowWindow)
      Logger "Slide Show Next Build" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowNextClick(ByVal Wn As SlideShowWindow, ByVal nEffect As Effect)
      Logger "Slide Show Next Click" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
      Logger "Slide Show Next Slide" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowOnNext(ByVal Wn As SlideShowWindow)
      Logger "Slide Show On Next" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_SlideShowOnPrevious(ByVal Wn As SlideShowWindow)
      Logger "Slide Show On Previous" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_WindowActivate(ByVal Pres As Presentation, ByVal Wn As DocumentWindow)
      Logger "Window Activate" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_WindowBeforeDoubleClick(ByVal Sel As Selection, Cancel As Boolean)
      Logger "Window Before Double Click" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_WindowBeforeRightClick(ByVal Sel As Selection, Cancel As Boolean)
      Logger "Window Before Right Click" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_WindowDeactivate(ByVal Pres As Presentation, ByVal Wn As DocumentWindow)
      Logger "Window Deactivate" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
  Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
      Logger "Window Selection Change" & vbTab & Format(Now, "dd-MMM-yyyy hh:mm:ss")
  End Sub
  
• Create New Module Named "Module1"
• Paste Below code 
• Option Explicit
  Const iLogFilePath = "c:\LogFiles"
  Dim cPPTObject As New clsEvent
  
  Sub SetPPT()
      Set cPPTObject.PPTEvent = Application
  End Sub
  
  
  Sub Logger(strLogDetails As String)
  ''''''''''''''''
  Dim fso As New FileSystemObject
  Dim myLogFile As TextStream
  Dim iLogFileName

你来block'''''''''''''''''''''''''''''''' 'iLogFileName = iLogFilePath&'iLogFileName = iLogFilePath& " \PP_Details_" &安培;格式（Now（），"dd_MMM_yy.txt"）
'''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' （iLogFileName，True，True）
否则
设置myLogFile = fso.OpenTextFile（iLogFileName，ForAppending，True，TristateUseDefault）结束如果是'''''''''' """""""""""""""""""""""""""""""""""""""""""""""""" 'On On Error Resume Next
myLogFile.WriteLine" -----------------------"
myLogFile.WriteLine " - " &安培; CStr（strLogDetails）
这起CS''一起str'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'myLogFile.Close
设置myLogFile =没什么事情'''''''''''''''''''''''''''''''''''''''''''''' '''结束次

创建新幻灯片。您可以从现有的电源指向文件中复制粘贴。

在第一个滑动插入文本框中，应用正确的文本。

选择文本框，单击"插入"功能区，单击操作，然后配置为宏名称" SetPPT "。

在c：\驱动器中创建一个文件夹，命名为" LogFiles"，您可以根据模块中的逻辑更改此文件夹名称。

幻灯片开始后，单击要调用的文本框，以捕获所有事件。

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    iLogFileName = iLogFilePath & "\PP_Details_" & Format(Now(), "dd_MMM_yy.txt")
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not fso.FileExists(iLogFileName) Then
        Set myLogFile = fso.CreateTextFile(iLogFileName, True, True)
    Else
        Set myLogFile = fso.OpenTextFile(iLogFileName, ForAppending, True, TristateUseDefault)
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    myLogFile.WriteLine "-----------------------"
    myLogFile.WriteLine "--" & CStr(strLogDetails)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    myLogFile.Close
    Set myLogFile = Nothing
''''''''''''''''
End Sub

Create New slides. You can copy paste from existing power pointing file.

On First slid insert text box, Apply proper text.

Select text box, Click on Insert Ribbon, Click on Action, and config to the macro name "SetPPT ".

Create one folder in your c:\ drive, Named "LogFiles", you can change the name of this folder name as per you logic from Module.

Once your slide starts click on the text box to invoke , to trap all the event.

这篇关于Powerpoint-Presentation：在演示时捕获幻灯片和内部幻灯片动画的持续时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！