Question

前提：我以前从未使用过VBA。

我想获得什么： 直接在幻灯片内，当我单击形状或按钮时，我想启动计时器，当我再次单击同一个对象时，我想显示从第一次单击到显示之间的经过时间第二个..

这是我所做的：

我创建了一个表单，并输入了以下代码

Private startTime As Date
Private endTime As Date


Private Sub CommandButton1_Click()
startTime = Now

End Sub

Private Sub CommandButton2_Click()
    endTime = Now


    TextBox2.Value = startTime
    TextBox3.Value = endTime
    TextBox1.Value = DateDiff("s", startTime, endTime)

End Sub

如您所见，我正在使用2个按钮。如何只用1个按钮就能做到相同？

是否可以在不使用表格的情况下做到这一点？

我认为直接在幻灯片内部会更漂亮（实际上，这是我需要做的）如果没有，如何使表格更美观？例如更改颜色，样式等

能给我提些建议吗？

Answer 1

尝试这个小型mod来满足您的需求：

Private Sub CommandButton1_Click()

Static StartTime As Double
Static Running As Boolean

Running = Not Running

If Running Then
    StartTime = Now
Else
    Running = False
    MsgBox DateDiff("s", StartTime, Now)
End If

End Sub

Answer 2

如果先添加VBA代码到演示文稿中，然后再添加要单击的特殊形状，则最容易遵循。此处的代码位于常规模块中，并将直接与您选择的任何幻灯片上的指定形状相关联。

Option Explicit

Private alreadyStarted As Boolean

Public Sub ClickCatcher(ByRef actionShape As Shape)
    Debug.Print "shape clicked: " & actionShape.Name
    If Not alreadyStarted Then
        StartCounter
        alreadyStarted = True
    Else
        Dim elapsed As Double
        elapsed = TimeElapsed() / 1000#
        MsgBox "Time Elapsed: " & Format(elapsed, "#.000 sec")
        alreadyStarted = False
    End If
End Sub

（我将在下面为您显示计时器代码）

很容易看到，使用全局变量alreadyStarted，您可以切换计时器以启动和停止并报告经过的时间（以毫秒为单位）。

Debug.Print语句显示单击的形状的名称。如果您有多个动作形状，那么此可能很重要。因此，您也许可以检查计时器形状的名称，而不要检查其他形状。

您需要的最终设置是为所选幻灯片添加“动作形状”。您可以从 INSERT 功能区执行此操作，然后选择 Shapes ，并一直滚动到底部，直到看到“动作形状”为止。选择您喜欢的任何一个并将其添加到幻灯片中。随即，您将看到一个弹出对话框，要求您提供操作设置。确保选择运行宏并选择了例程的名称（在这种情况下为ClickCatcher）。

现在进入“演示”模式，在该形状上单击一次，然后再次单击，MsgBox将弹出，显示经过的时间。

这是精确计时器代码。我建议创建一个单独的代码模块并将其复制到那里。

Option Explicit

'------------------------------------------------------------------------------
' For Precision Counter methods
'
Private Type LargeInteger
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib _
                         "kernel32" (lpPerformanceCount As LargeInteger) As Long
Private Declare Function QueryPerformanceFrequency Lib _
                         "kernel32" (lpFrequency As LargeInteger) As Long

Private counterStart As LargeInteger
Private counterEnd As LargeInteger
Private crFrequency As Double

Private Const TWO_32 = 4294967296#               ' = 256# * 256# * 256# * 256#

'==============================================================================
' Precision Timer Controls
'
Private Function LI2Double(lgInt As LargeInteger) As Double
    '--- converts LARGE_INTEGER to Double
    Dim low As Double
    low = lgInt.lowpart
    If low < 0 Then
        low = low + TWO_32
    End If
    LI2Double = lgInt.highpart * TWO_32 + low
End Function

Public Sub StartCounter()
    '--- Captures the high precision counter value to use as a starting
    '    reference time.
    Dim perfFrequency As LargeInteger
    QueryPerformanceFrequency perfFrequency
    crFrequency = LI2Double(perfFrequency)
    QueryPerformanceCounter counterStart
End Sub

Public Function TimeElapsed() As Double
    '--- Returns the time elapsed since the call to StartCounter in microseconds
    If crFrequency = 0# Then
        Err.Raise Number:=11, _
                  Description:="Must call 'StartCounter' in order to avoid " & _
                                "divide by zero errors."
    End If
    Dim crStart As Double
    Dim crStop As Double
    QueryPerformanceCounter counterEnd
    crStart = LI2Double(counterStart)
    crStop = LI2Double(counterEnd)
    TimeElapsed = 1000# * (crStop - crStart) / crFrequency
End Function

使用VBA获取Powerpoint幻灯片中同一对象两次单击之间的经过时间

2 个答案: