vba - 有没有办法检查是否使用 VBA 代码呈现 PowerPoint?
问题描述
我正在为交互式 PowerPoint 开发 VBA 模块。具体来说,我想要一个文本框来显示当前时间并使用 VBA 每秒更新一次(如实时时钟)。我已经创建并实现了时钟,只是时钟在演示结束时不会退出其循环,并且在演示模式之外编辑 PowerPoint 时将继续更新文本框。我试过使用sub App_SlideShowEnd(ByVal Pres As Presentation)
(https://docs.microsoft.com/en-us/office/vba/api/powerpoint.application.slideshowend),(https://docs.microsoft.com/en-us/office/ _ vba/api/powerpoint.application.slideshownextslide),甚至是一个名为 AutoEvents 的加载项(此处显示的用法http://www.mvps.org/skp/autoevents.htm#Usesub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
) 赶上幻灯片的结尾,但无济于事。
所以我的问题是:有没有办法检查当前的 PowerPoint 是否正在积极展示?如果是这样,我可以使用它来检查 PowerPoint 是否正在呈现,而不是检查我的布尔变量clockstate
是否允许时钟计数。这是时钟子的实现:
Sub clock()
Do Until clockstate = False
MsgBox ActivePresentation.SlideShowWindow.View
Injury.TextFrame.TextRange.text = (Date - entryA) & ":" & Mid(CStr(Time()), 1, Len(Time()) - 3)
Defect.TextFrame.TextRange.text = (Date - entryB) & ":" & Mid(CStr(Time()), 1, Len(Time()) - 3)
Call Wait(1)
Loop
End Sub
Sub Wait(sec As Integer)
Dim temp_time As Variant
temp_time = Timer
Do While Timer < temp_time + sec
DoEvents 'this allows for events to continue while waiting for sec seconds
Loop
End Sub
这是App_SlideShowEnd
事件的实现:
Sub App_SlideShowEnd(ByVal Pres As Presentation)
clockstate = False
End Sub
如果你想看它的话,这里是我所有的代码:
Option Explicit
Dim indexA As Integer 'this variable contains the slide that Injury_Time is found on for use in the auto next slide event
Dim indexB As Integer 'this varaible contains the slide that Defect_Time is found on for use in the auto next slide event
Dim clockstate As Boolean 'this varaible dictates wether or not the clock is on and counting to save memory/processing resources.
Dim Injury As Shape 'this variable is used to reference the textbox that gets changed by the macro
Dim Defect As Shape 'this varaible is used to reference the other textbox that gets changed by the macro
Dim entryA As Date 'this holds the contents of the first entrybox on the config form so the form can be unloaded without losing the entries
Dim entryB As Date 'this holds the contents of the second entrybox on the config form so the form can be unloaded without losing the entries
Dim daysA As String 'this holds the number of days since last injury for auto-setting the textboxes in the config form
Dim daysB As String 'this holds the number of days since last defect for auto-setting the textboxes in the config form
Sub Auto_Open() 'runs on startup from AutoEvents add-in. runs the find function to locate the Macro-edited slides, then opens the config form
'declare clockstate as false until it is true and turned on
clockstate = False
'assign values the global Injury and Defect variables
Call Find
'try calling the name fields (need to assign it to a variable to try it). If Injury and Defect were found, then nothing happens. Otherwise it moves the the Not_Found label
On Error GoTo Not_Found
'setup daysA and daysB
daysA = Left(Injury.TextFrame.TextRange.text, Len(Injury.TextFrame.TextRange.text) - 8)
daysB = Left(Defect.TextFrame.TextRange.text, Len(Defect.TextFrame.TextRange.text) - 8)
'assign default values to the Config boxes
Config.TextBox1.Value = Date - daysA
Config.TextBox2.Value = Date - daysB
'show config
Config.Show
Exit Sub
'error messaging for if the textbox assignments were not found
Not_Found:
MsgBox "Error: The Macro-edited textbox(es) were not found! This is likely due to the most recent editing preformed on this Powerpoint. Please revert the changes, create a new textbox with the name """"Injury_Time"""" or """"Defect_time"""" (whichever is missing), contact your local VBA expert, or read the Documentation for help."
End Sub
Sub Find() 'locates the textbox that the global variables Injury and Defect are supposed to represent
'use a 2D for loop to iterate through each slide and it's shapes
Dim i As Integer
Dim j As Integer
For i = 1 To ActivePresentation.Slides.Count
For j = 1 To ActivePresentation.Slides(i).Shapes.Count
If StrComp(ActivePresentation.Slides(i).Shapes(j).Name, "Injury_Time") = 0 Then
Set Injury = ActivePresentation.Slides(i).Shapes(j)
indexA = i
End If
If StrComp(ActivePresentation.Slides(i).Shapes(j).Name, "Defect_Time") = 0 Then
Set Defect = ActivePresentation.Slides(i).Shapes(j)
indexB = i
End If
Next j
Next i
End Sub
Sub Save() 'saves the contents of the config form to the global varaibles entryA and entry B then unloads the form to save memory
'save the contents of the config form so we can unload it to save memory
entryA = Config.TextBox1.Value
entryB = Config.TextBox2.Value
'unload the form to save memory
Unload Config
End Sub
Sub Auto_ShowBegin() 'starts the clock for the timers when the show starts
'start clock
clockstate = True
Call clock
End Sub
Sub clock()
Do Until clockstate = False
MsgBox ActivePresentation.SlideShowWindow.View
Injury.TextFrame.TextRange.text = (Date - entryA) & ":" & Mid(CStr(Time()), 1, Len(Time()) - 3)
Defect.TextFrame.TextRange.text = (Date - entryB) & ":" & Mid(CStr(Time()), 1, Len(Time()) - 3)
Call Wait(1)
Loop
End Sub
Sub Wait(sec As Integer)
Dim temp_time As Variant
temp_time = Timer
Do While Timer < temp_time + sec
DoEvents 'this allows for events to continue while waiting for sec seconds
Loop
End Sub
Sub App_SlideShowEnd(ByVal Pres As Presentation)
clockstate = False
End Sub
Sub Auto_Close() 'this is run by the AutoEvents add-in. It displays an informative message when the powerpoint is closed with instructions for the next time the powerpoint is opened
'prevent clock from running after program is closed
clockstate = False
'message to configure the powerpoint when it is opened again
MsgBox "Thank you for using this Macro-Enabled PowerPoint!" & vbCrLf & vbCrLf & "Next time the PowerPoint is opened, you will be asked to re-enter the dates of the most recent injury and quality defect."
End Sub
感谢您的帮助,愿 4 日与您同在!
解决方案
推荐阅读
- swift - 无法将类型“(Int)-> Bool”的值转换为预期的条件类型“Bool”,并且在范围内找不到 x
- java - 为什么在 Java TreeMap 中调用 iterator.remove() 时相同的 Map.Entry 会发生变化?
- go - 使用 Golang 更新 KML 文件中的节点
- android - 类型不匹配。必需:结果
- >!发现:成功
- r - R - 基于交叉测试的聚合层次结构
- python - PyPDF2 编写的 PDF 显示在 Acrobat 中打开时的更改
- javascript - 带相机的 A 帧多个动画
- linux - 如何在不进入 docker-compose.yml 的情况下添加一行
- flutter - 无法在 MacO 上安装 Flutter,提示解压缩过程不起作用
- reactjs - 使用 react-phone-input-2 作为 Ant AutoComplete 的自定义输入