Đồng hồ đếm ngược trên form

[anktdn]

Em cần đồng hồ đếm ngược trên form, khi chạy hết thời gian thì tự động khóa sheet lại, mong các Pác giúp.

 

[ndu96081631]

Bạn ndu kính mến! (nhưng có lẽ mình nhiều tuổi hơn Bạn, hì)

Nếu thế thì em gọi bằng ANH vậy!

Mình hỏi thêm là cái đồng hồ này khác với đồng hồ cũ (file CountDown_on_Form_3.xls) như thế nào? Vì đồng hồ cũ khi vừa chạy mình cũng đã vừa làm việc trên file được rồi mà.

Để Form hoạt động mà ta vẫn thao tác được trên sheet thì trong phần Properties của UserForm, set mục ShowModal = False (như hình)




Tuy nhiên, để có thể THAO TÁC TRÊN SHEET 1 CÁCH BÌNH THƯỜNG thì không đơn giản thế ---> Anh mở file CountDown_in_Form_3.xls, cho Form chạy xem có Format Cells, tô chữ đậm, nghiêng, chọn size chữ... được hay không? (thậm chí Undo còn không được nữa là...)
Gọi là THAO TÁC BÌNH THƯỜNG có nghĩa là Form chạy cứ chạy mà không ảnh hưởng tí gì đến các thao tác của ta ---> Và làm được điều đó chỉ có thể là hàm SetTimer (API)

 

[thanhlanh]

Tuy nhiên, để có thể THAO TÁC TRÊN SHEET 1 CÁCH BÌNH THƯỜNG thì không đơn giản thế ---> Anh mở file CountDown_in_Form_3.xls, cho Form chạy xem có Format Cells, tô chữ đậm, nghiêng, chọn size chữ... được hay không? (thậm chí Undo còn không được nữa là...)
Gọi là THAO TÁC BÌNH THƯỜNG có nghĩa là Form chạy cứ chạy mà không ảnh hưởng tí gì đến các thao tác của ta ---> Và làm được điều đó chỉ có thể là hàm SetTimer (API)

Quá tuyệt!
May nhờ ndu giảng mình mới nhận ra (vì không chịu kiểm tra kỹ), đồng hồ chạy mà như không chạy, thậm chí vừa viết code, vừa chạy cũng OK, nó chỉ khựng lại trong tích tắc khi nhấn chuột phải.

 

[hongquanjp]

Cho em hỏi nếu thay chạy trên Form bằng hiển thị trực tiếp vào Cell thì làm thế nào?

 

[Hai Lúa Miền Tây]

Cho em hỏi nếu thay chạy trên Form bằng hiển thị trực tiếp vào Cell thì làm thế nào?

Tham khảo bài viết sau nhé
http://www.giaiphapexcel.com/forum/...huông-báo-giờ-trong-Excel&p=181832#post181832

 

[hochoi29]

Làm luôn cho bạn đây:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Check As Boolean

Private Sub Cmd1_Click()
  Dim LB As Control, TG As Double, ms As Long
  On Error Resume Next
  Set LB = UserForm1.Label1
  Check = (Cmd1.Caption = "Start")
  If UserForm1.Visible = False Then UserForm1.Show
  TG = IIf(LB.Caption = "00:00:00:00", TimeSerial(0, 0, 15), TimeValue(Left(LB.Caption, 8)))
  Cmd1.Caption = IIf(Check, "Stop", "Start")
  Do While Check
    DoEvents
    TG = TG - TimeSerial(0, 0, 1)
    ms = 100
    Do
      ms = ms - 1
      LB.Caption = Format(TG, "hh:mm:ss") & ":" & Format(ms, "00")
      Sleep 10
      DoEvents
      If LB.Caption = "00:00:00:00" Then
        Check = False
        Cmd1.Caption = "Start"
      End If
    Loop Until ms = 0 Or Check = False
  Loop
End Sub

Private Sub Cmd2_Click()
  If UserForm1.Visible Then
    Check = False
    Unload UserForm1
    Cmd1.Caption = "Start"
  End If
End Sub

View attachment 48173

Mới tạm xong! Chắc còn có thể rút gọn thêm nữa ---> Bạn "cày" thử xem!

Để làm đồng hồ kiểu này mà thời gian tăng thì sửa như thế nào à!
Xin cảm ơn!

 

[binhbia9]

Gửi các anh,
Nếu bây giờ muốn vừa mở sheet ra sẽ hiện ra đồng hồ đếm ngược luôn thì phải làm sao ạ hic hic

 

[zenphone]

Anh Ndu có thể giúp em mod lại một số file này giúp em được không nhé:

- Không sử dụng Button Show/Stop trong sheet nữa.
- Khi mở file excel lên sẽ hiện ra 1 hộp thoại với msg box "bạn đã sẵn sàng chưa" => OK => vào sheet làm việc đồng thời đồng hồ bắt đầu đếm ngược luôn.

Cám ơn anh nhiều

Xem file này thử nhé

 

[zenphone]

Em gửi lại file gốc.

 

[zenphone]

em gửi file gốc, giúp em tạo msg box

 

[ducanh010]

Làm được như bạn nói thật chẳng dễ ăn đâu! Nếu không dùng hàm API thì... đừng có mơ
Cách làm như sau:
1> Trên Sheet
- Vẽ 2 CommandButton, đặt tên là Cmd1 và Cmd2, có Caption là Start và Close Form
- Code cho 2 Command Button này:

Private Sub Cmd1_Click()
  With Sheet1.Cmd1
    .Caption = IIf(.Caption = "Start", "Stop", "Start")
    Run IIf(.Caption = "Stop", "StartTimer", "StopTimer")
  End With
  With UserForm1
    If .Visible = False Then .Show
    If .Visible Then
      If .Label1.Caption = "00:00:00:00" Then Tmp = TimeValue("00:00:15")
    End If
  End With
End Sub

Private Sub Cmd2_Click()
  StopTimer
  Unload UserForm1
End Sub

2> Trong Module

Declare Function SetTimer Lib "User32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "User32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public iT As Double, ms As Double, Tmp As Double

Sub StartTimer()
  StopTimer
  SetTimer Application.hwnd, 1, 10, AddressOf TimeProc
End Sub

Sub StopTimer()
  KillTimer Application.hwnd, 1
End Sub

Function TimeProc()
  On Error Resume Next
  With UserForm1
    If .Label1.Caption = "00:00:00:01" Then
      StopTimer
      Sheet1.Cmd1.Caption = "Start"
    End If
    iT = iT + 1
    ms = (100 - (iT Mod 100)) Mod 100
    If ms = 99 Then Tmp = Tmp - TimeValue("00:00:01")
    .Label1.Caption = Format(Tmp, "hh:mm:ss") & ":" & Format(ms, "00")
  End With
End Function

3> Trong UserForm

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Sub UserForm_Initialize()
  Dim hwnd As Long, HT As Double
  HT = Me.Height - Me.InsideHeight
  hwnd = FindWindow("ThunderDFrame", Me.Caption)
  SetWindowLong hwnd, -16, &H84080080
  Me.Height = Me.Height - HT
  Tmp = TimeValue("00:00:15")
End Sub

Private Sub UserForm_Terminate()
  StopTimer
  ms = 0: iT = 0: Tmp = 0
  Sheet1.Cmd1.Caption = "Start"
End Sub

Xem file đính kèm! ---> Form cứ chạy và ta vẫn làm việc bình thường!
Vì dùng hàm SetTimer khá nguy hiểm nên các bạn hãy test thử xem có trục trặc gì không nha

Chào thầy Ndu!
Em xin phép lục lại bài viết cũ ạ.
Em thử sử dụng file thầy làm như code ở trên để đồng hồ đếm ngược không bị dừng khi ta làm việc. Nhưng báo lỗi ở đoạn code sau: Lỗi Type Mismatch kèm bôi đen ở dòng: AddressOf TimeProc

PHP:
Sub StartTimer()
StopTimer
SetTimer Application.hwnd, 1, 10, AddressOf TimeProc
End Sub

Em có tải được file mẫu của các thầy trên GPE và Youtube. Nhưng khi click đúp vào 1 cell thì đồng hồ dừng.
E up file lên đây, thầy có thể sửa giúp em để đồng hồ vẫn chạy khi ta làm việc được không ạ!
Em cảm ơn rất nhiều ạ.
(Bản chất e chưa học VBA, em chỉ biết 1 chút để có thể sử dụng được Marco và các đoạn code có sẵn các thầy cô bạn bè share thôi, nên có gì mong thầy bỏ qua ạ!)