Получите затраченное время между 2 щелчками на одном и том же объекте в слайде PowerPoint с помощью VBA

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

Проще всего следовать, если сначала добавить код 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

Answer 2

Попробуйте этот небольшой мод на то, что у вас есть:

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