Nhờ các thêm chức năng dừng lại và tiếp tục chạy cho đồng hồ trong PowerPoint. (1 người xem)

[Ngày mai trời lại sáng]

Xin chào các bạn.
Tôi có tải được đồng hồ đếm ngược trong PowerPoint hiện mới có chức năng băt đầu chưa có chức năng dừng lại và tiếp tục
Nhờ các bạn thêm giúp tôi 2 chức năng này với.

 

[giaiphap]

Xin chào các bạn.
Tôi có tải được đồng hồ đếm ngược trong PowerPoint hiện mới có chức năng băt đầu chưa có chức năng dừng lại và tiếp tục
Nhờ các bạn thêm giúp tôi 2 chức năng này với.

Bạn tùy biến nhé, cái này là tui lấy thời gian trên máy và thể hiện lên Slide.

 

[Ngày mai trời lại sáng]

Bạn tùy biến nhé, cái này là tui lấy thời gian trên máy và thể hiện lên Slide.

Cảm ơn anh đã giúp đỡ, ý em là khi mà đếm ngược xong mình cho dừng lại rồi tiếp tục thì sẽ đếm ngược từ con số dừng lại anh à.
Ví dụ em cho đếm ngược bắt đầu từ 30 xuống đến 10 em dừng lại sau đó bấm tiếp tục thì lại bắt đầu đếm ngược từ 10 ạ.

 

[giaiphap]

Cảm ơn anh đã giúp đỡ, ý em là khi mà đếm ngược xong mình cho dừng lại rồi tiếp tục thì sẽ đếm ngược từ con số dừng lại anh à.
Ví dụ em cho đếm ngược bắt đầu từ 30 xuống đến 10 em dừng lại sau đó bấm tiếp tục thì lại bắt đầu đếm ngược từ 10 ạ.

Thì tui đã nói rồi mà, tùy biến khi sử dụng code. Code trên là ví dụ mẫu cho đồng hồ nó chạy thôi, còn muốn như bạn thì phải sửa code chứ sau áp dụng y nguyên vậy được.

Option Explicit
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongLong) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Public TimerID As LongPtr
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Public TimerID As Long
#End If
Public bTimerState As Boolean
Public giay As Long
Function FormatGiay(g As Long) As String
    FormatGiay = Format(Int(giay / 60), "00") & ":" & Format(Int(giay Mod 60), "00")
End Function

Sub TimerOnOff()
    If giay = 0 Then giay = 120 '2 phut
    With ActivePresentation.Slides(ActivePresentation.SlideShowWindow.View.Slide.SlideIndex)
    If bTimerState = False Then
        .Shapes("aTime").TextFrame.TextRange.Text = FormatGiay(giay)
        TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
        If TimerID = 0 Then Exit Sub
        .Shapes("btn").TextFrame.TextRange.Text = "Stop"
    Else
        TimerID = KillTimer(0, TimerID)
        .Shapes("btn").TextFrame.TextRange.Text = "Start"
    End If
    bTimerState = Not bTimerState
    End With
End Sub
#If VBA7 And Win64 Then
Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As LongLong)
#Else
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
#End If
    On Error Resume Next
    With ActivePresentation.Slides(ActivePresentation.SlideShowWindow.View.Slide.SlideIndex)
        giay = giay - 1
        .Shapes("aTime").TextFrame.TextRange.Text = FormatGiay(giay)
        If giay = 0 Then
            TimerID = KillTimer(0, TimerID)
            .Shapes("btn").TextFrame.TextRange.Text = "Start"
        End If
    End With
End Sub

 

[Ngày mai trời lại sáng]

Thì tui đã nói rồi mà, tùy biến khi sử dụng code. Code trên là ví dụ mẫu cho đồng hồ nó chạy thôi, còn muốn như bạn thì phải sửa code chứ sau áp dụng y nguyên vậy được.

Option Explicit
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongLong) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Public TimerID As LongPtr
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Public TimerID As Long
#End If
Public bTimerState As Boolean
Public giay As Long
Function FormatGiay(g As Long) As String
    FormatGiay = Format(Int(giay / 60), "00") & ":" & Format(Int(giay Mod 60), "00")
End Function

Sub TimerOnOff()
    If giay = 0 Then giay = 120 '2 phut
    With ActivePresentation.Slides(ActivePresentation.SlideShowWindow.View.Slide.SlideIndex)
    If bTimerState = False Then
        .Shapes("aTime").TextFrame.TextRange.Text = FormatGiay(giay)
        TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
        If TimerID = 0 Then Exit Sub
        .Shapes("btn").TextFrame.TextRange.Text = "Stop"
    Else
        TimerID = KillTimer(0, TimerID)
        .Shapes("btn").TextFrame.TextRange.Text = "Start"
    End If
    bTimerState = Not bTimerState
    End With
End Sub
#If VBA7 And Win64 Then
Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As LongLong)
#Else
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
#End If
    On Error Resume Next
    With ActivePresentation.Slides(ActivePresentation.SlideShowWindow.View.Slide.SlideIndex)
        giay = giay - 1
        .Shapes("aTime").TextFrame.TextRange.Text = FormatGiay(giay)
        If giay = 0 Then
            TimerID = KillTimer(0, TimerID)
            .Shapes("btn").TextFrame.TextRange.Text = "Start"
        End If
    End With
End Sub

Em cảm ơn anh nhiều,đúng ý em rồi.
Chúc anh ngày mới vui khỏe.