Đồng hồ đếm ngược trên form (5 người xem)
- Thread starter anktdn
- Ngày gửi
Người dùng đang xem chủ đề này
- Tham gia
- 21/12/07
- Bài viết
- 1,902
- Được thích
- 5,303
- Nghề nghiệp
- Kinh doanh các mặt hàng văn phòng phẩm
Về đồng hồ đếm ngược thì bạn tìm hiểu thêm trên diễn đàn. Mình chỉ nói đến thuật toán xác định thời gian đóng form
Ta tạo 1 Userform. Sử dụng sự kiện Active để xác định thời gian mở form
PHP:
Private Sub UserForm_Activate()
Application.OnTime Now + TimeValue("00:00:05"), "dongform"
End SubSau khi mở form 5 giây, thủ tục trên sẽ gọi thủ tục đóng form.
Bạn Insert module và nhập thủ tục này vào.
PHP:
Sub dongform()
UserForm1.Hide
End Sub
Upvote
0
Có thêm đồng hồ đếm ngược chạy trên form thì hay quá .
Upvote
0
sealand
Thành viên gạo cội
- Tham gia
- 16/5/08
- Bài viết
- 4,883
- Được thích
- 7,688
- Giới tính
- Nam
- Nghề nghiệp
- Kế Toán
Không phải vậy đâu Hoang Danh à, ý bạn ấy là cần bổ xung điều khiển Timer trong VB ấy. Như vậy trong thời gian cho phép thì người dùng muốn làm gì thì làm nhưng hết giờ buộc phải thoát. Còn như bạn thì nó giống như flash form thôi. Không hiếu sao máy của mình có điều khiển Timer nhưng không ad được nên đành chịu.
Lần chỉnh sửa cuối:
Upvote
0
Đúng như ý bạn nói, mình muốn hiển thị thời gian chạy trên form ví dụ trên form sẽ hiển thị 10:15, khi chạy hết đúng 10phút 15 giây form sẽ đóng lại. Ai có ý tưởng hay xin chì giúp. thanks
Upvote
0
Here is some code that works in Excel 97.
On the userform., two buttons to start and stop the timer and a label, lblCountdown, and this code
VBA:
VBA tags courtesy of www.thecodenet.com
In a general module, this code
VBA:
VBA tags courte
Tìm trên trang vba của tác giả XLD viết code cho bộ đồng hồ đếm ngược, mình đã thiết kế được đồng hồ trên form ,gửi file lên đẩ các bạn tham khảo, code đơn giản nhưng ứng dụng rất hay.
On the userform., two buttons to start and stop the timer and a label, lblCountdown, and this code
VBA:
PHP:
Private Sub cmdStart_Click()
nTime = nCount
Call RunTimer
End Sub
PHP:
Private Sub cmsdStop_Click()
nTime = 0
End SubVBA tags courtesy of www.thecodenet.com
In a general module, this code
VBA:
PHP:
Public Const nCount As Long = 30 ' secs
Public nTime As Double
Public Sub RunTimer()
If nTime > 1 Then
nTime = nTime - 1
UserForm1.lblCountDown.Caption = Format(TimeSerial(0, 0, nTime), "hh:mm:ss")
Application.OnTime Now + TimeSerial(0, 0, 1), "RunTimer"
Else
Unload UserForm1
End If
End SubVBA tags courte
Tìm trên trang vba của tác giả XLD viết code cho bộ đồng hồ đếm ngược, mình đã thiết kế được đồng hồ trên form ,gửi file lên đẩ các bạn tham khảo, code đơn giản nhưng ứng dụng rất hay.
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote
0
Có vấn đề khi dùng lệnh OnTime là người dùng nếu điều chỉnh lại đồng hồ của máy tính (win) thì tẻo, excel có nhược điểm là phụ thuộc vào giờ hệ thống (win) bởi vậy khi làm các file có các macro điều khiển bằng time thì bị người dùng sửa giờ hệ thống để lách. Đang đau đầu vì không biết làm thế nào để xây dựng được 1 cái đồng hồ độc lập (không phụ thuộc vào giờ hệ thống) để khi đến những mốc thời gian hạn định file tự chạy các macro theo mình mong muốn mà những người dùng khác không lách được.
Upvote
0
ongtrungducmx25
Thành viên gạo cội
- Tham gia
- 5/2/07
- Bài viết
- 2,077
- Được thích
- 1,987
- Nghề nghiệp
- GV
thấy đồng hồ đếm ngược không biết chèn âm thanh vào như thế nào đây!
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
Vấn đề này nói nhiều trên diển đàn rồi mà:
Chèn âm thanh dạng MIDI:
http://www.giaiphapexcel.com/forum/showpost.php?p=167468&postcount=15
Chèn âm thanh dạng MP3:
http://www.giaiphapexcel.com/forum/showpost.php?p=211401&postcount=1
Trong đó chèn âm thanh MIDI là dể nhất
Upvote
0
Candlelight
Thành viên chính thức
- Tham gia
- 23/11/09
- Bài viết
- 55
- Được thích
- 191
Có thể tạo đồng hồ đếm ngược trên Form, nhưng đếm tới phần trăm của giây được không ạ?
Thay vì "00:00:00" thì thành "00:00:00:00"
Cám ơn rất nhiều ạ!
Thay vì "00:00:00" thì thành "00:00:00:00"
Cám ơn rất nhiều ạ!
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
Có lẽ không được vì Excel chỉ có cấu trúc này:
TimeSerial(0, 0, 0) hoặc TimeValue("00:00:00", đâu có cái nào nói % đâu nhỉ? Ẹc ẹc...
Chưa chắc đâu! Hàm Sleep (API) cho phép Delay 1/1000 giây
Vậy:
- Mỗi lần ta Delay 10 đơn vị, tương đương 1/100 giây
- Mỗi lần Delay như thế, ta ghép giá trị tính toán vào 1 biến... Biến này sẽ dùng phép ghép chuổi để cho vào 2 số sau cùng của Label
- Sau khi Delay đúng 1 giây, thì sẽ trừ giá trị giây 1 đơn vị
vân.. vân...
Tôi chưa làm nhưng tôi nghĩ là.. CÓ THỂ
Lần chỉnh sửa cuối:
Upvote
0
Candlelight
Thành viên chính thức
- Tham gia
- 23/11/09
- Bài viết
- 55
- Được thích
- 191
Thầy nói cao siêu quá, em chẳng hiểu "tẹo" nào hết đó! Cám ơn Thầy!
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
Ôi... tôi không nghĩ là nó quá khó hiểu
- Đếm ngược như các bài trước người ta delay 1 giây 1 lần và mỗi lần như thế người ta trừ giá trị giây của Label 1 đơn vị, đúng không
- Vậy để làm thêm 2 số như bạn nói thì trong khoảng thời gian 1 giây này, ta Delay thêm 100 lần nữa, mỗi lần là 10 đơn vị (của hàm Sleep), tương đương 1/100 giây
Thuật toán chỉ vậy thôi, còn việc tính toán thế nào để đưa giá trị vào 2 số sau của Label là việc của... mọi người
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
Làm luôn cho bạn đây:
PHP:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Check As Boolean
PHP:
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
PHP:
Private Sub Cmd2_Click()
If UserForm1.Visible Then
Check = False
Unload UserForm1
Cmd1.Caption = "Start"
End If
End Sub
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!
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
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:
PHP:
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
PHP:
Private Sub Cmd2_Click()
StopTimer
Unload UserForm1
End Sub
PHP:
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
PHP:
Sub StartTimer()
StopTimer
SetTimer Application.hwnd, 1, 10, AddressOf TimeProc
End Sub
PHP:
Sub StopTimer()
KillTimer Application.hwnd, 1
End Sub
PHP:
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
PHP:
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
PHP:
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
PHP:
Private Sub UserForm_Terminate()
StopTimer
ms = 0: iT = 0: Tmp = 0
Sheet1.Cmd1.Caption = "Start"
End SubVì 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
Upvote
0
thanhlanh
Thành viên tích cực
- Tham gia
- 21/2/08
- Bài viết
- 858
- Được thích
- 1,211
Bạn ndu kính mến! (nhưng có lẽ mình nhiều tuổi hơn Bạn, hì)
Thật tình mình đâu dám làm phiền bạn nhiều vậy?
Mình chỉ hỏi một vài câu lệnh mà Bạn làm cho cả bài, Bạn rất giỏi và nhiệt tình!
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à.
Upvote
0
Lão già Chết Tiệt
Thành viên mới
- Tham gia
- 2/12/10
- Bài viết
- 11
- Được thích
- 8
Tôi nghĩ không quá phức tạp đâu ông bạn ơi, mở VBA ra, chọn thuộc tính trên form là ShowModal chọn là False thì ông bạn có thể vừa thao tác trên form vừa thao tác trên excel được. Tôi nói vậy không biết có đúng ý ông anh không?
Upvote
0
Bài viết mới nhất
Xin Code xóa Module.
(1 người xem)
TRỢ GIÚP K SORT ĐƯỢC THỨ TỰ NGÀY THÁNG NĂM TRONG EXCEL
(1 người xem)
Hỗ trợ công thức tính điểm dựa theo điều kiện.
(1 người xem)
- Question
- Question