Giúp code sau 10 giây tự động unload me Userform

Liên hệ QC
1

1+1=2

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
5/7/20
Bài viết
62
Được thích
12
Cháu chào tất cả cô chú. Cháu cần câu lệnh sau 1 thời gian ( cụ thế ví dụ 10 giây ) userform tự động Unload me thì dùng câu lệnh gì. và có thêm 1 label đếm ngược từ 10 về 0 nữa thì càng tuyệt vời

1595601362347.png

Sub test()
UserForm1.Show
'--sau 10 giay
Unload Me
End Sub

Cháu xin chân thành cảm ơn ạ
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
1+1=2 đã viết:
Cháu chào tất cả cô chú. Cháu cần câu lệnh sau 1 thời gian ( cụ thế ví dụ 10 giây ) userform tự động Unload me thì dùng câu lệnh gì. và có thêm 1 label đếm ngược từ 10 về 0 nữa thì càng tuyệt vời

View attachment 241775

Sub test()
UserForm1.Show
'--sau 10 giay
Unload Me
End Sub

Cháu xin chân thành cảm ơn ạ
Nhấp chuột vào đây để mở rộng...
Bạn mô tả nghe "nhẹ nhàng" quá. Thực ra là không phải chuyện dễ ăn đâu nha
Tôi làm thử
1> Trên UserForm, vẽ 3 Label:
- Label1 chứa chuỗi: "Vui lòng đợi. Còn"
- Label2 chứa chuỗi: "giây nữa"
- Label3 để trống và nằm giữa Label1 và Label2
2> Code trong UserForm:
Mã: 
Private Sub UserForm_Initialize()
  hWnd = Application.hWnd
  lCount = 5 '<--- Chỉnh số giây ở đây
  StartTimer
End Sub
Private Sub UserForm_Terminate()
  StopTimer
End Sub
3> Code trong module
Mã: 
Private Declare PtrSafe Function SetTimer Lib "user32" _
    (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
    (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

Public lCount As Long, hWnd As LongPtr
Sub StartTimer()
  StopTimer
  SetTimer hWnd, 0, 1000, AddressOf TimeProc
End Sub
Sub StopTimer()
  KillTimer hWnd, 0
End Sub
Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  lCount = lCount - 1
  If lCount <= -1 Then
    Unload UserForm1
    Exit Function
  End If
  UserForm1.Label3.Caption = lCount
  Beep
End Function
Sub ShowForm()
  UserForm1.Show
End Sub
4> Vẽ 1 button trên bảng tính, assign macro nó với Sub ShowForm
5> Bấm nút và thử
--------------------------------------------------------
Dù chưa hoàn chỉnh lắm nhưng.. đại khái vậy!
 

File đính kèm

  • Form_AutoClose.xlsm
    21.7 KB · Đọc: 22
Upvote 0
ndu96081631 đã viết:
Bạn mô tả nghe "nhẹ nhàng" quá. Thực ra là không phải chuyện dễ ăn đâu nha
Tôi làm thử
1> Trên UserForm, vẽ 3 Label:
- Label1 chứa chuỗi: "Vui lòng đợi. Còn"
- Label2 chứa chuỗi: "giây nữa"
- Label3 để trống và nằm giữa Label1 và Label2
2> Code trong UserForm:
Mã: 
Private Sub UserForm_Initialize()
  hWnd = Application.hWnd
  lCount = 5 '<--- Chỉnh số giây ở đây
  StartTimer
End Sub
Private Sub UserForm_Terminate()
  StopTimer
End Sub
3> Code trong module
Mã: 
Private Declare PtrSafe Function SetTimer Lib "user32" _
    (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
    (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

Public lCount As Long, hWnd As LongPtr
Sub StartTimer()
  StopTimer
  SetTimer hWnd, 0, 1000, AddressOf TimeProc
End Sub
Sub StopTimer()
  KillTimer hWnd, 0
End Sub
Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  lCount = lCount - 1
  If lCount <= -1 Then
    Unload UserForm1
    Exit Function
  End If
  UserForm1.Label3.Caption = lCount
  Beep
End Function
Sub ShowForm()
  UserForm1.Show
End Sub
4> Vẽ 1 button trên bảng tính, assign macro nó với Sub ShowForm
5> Bấm nút và thử
--------------------------------------------------------
Dù chưa hoàn chỉnh lắm nhưng.. đại khái vậy!
Nhấp chuột vào đây để mở rộng...

Cháu cảm ơn chú nhiều lắm. Code rất ưng ý luôn ạ
 
Upvote 0
ndu96081631 đã viết:
Bạn mô tả nghe "nhẹ nhàng" quá. Thực ra là không phải chuyện dễ ăn đâu nha
Tôi làm thử
1> Trên UserForm, vẽ 3 Label:
- Label1 chứa chuỗi: "Vui lòng đợi. Còn"
- Label2 chứa chuỗi: "giây nữa"
- Label3 để trống và nằm giữa Label1 và Label2
2> Code trong UserForm:
Mã: 
Private Sub UserForm_Initialize()
  hWnd = Application.hWnd
  lCount = 5 '<--- Chỉnh số giây ở đây
  StartTimer
End Sub
Private Sub UserForm_Terminate()
  StopTimer
End Sub
3> Code trong module
Mã: 
Private Declare PtrSafe Function SetTimer Lib "user32" _
    (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
    (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

Public lCount As Long, hWnd As LongPtr
Sub StartTimer()
  StopTimer
  SetTimer hWnd, 0, 1000, AddressOf TimeProc
End Sub
Sub StopTimer()
  KillTimer hWnd, 0
End Sub
Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  lCount = lCount - 1
  If lCount <= -1 Then
    Unload UserForm1
    Exit Function
  End If
  UserForm1.Label3.Caption = lCount
  Beep
End Function
Sub ShowForm()
  UserForm1.Show
End Sub
4> Vẽ 1 button trên bảng tính, assign macro nó với Sub ShowForm
5> Bấm nút và thử
--------------------------------------------------------
Dù chưa hoàn chỉnh lắm nhưng.. đại khái vậy!
Nhấp chuột vào đây để mở rộng...
1595662964042.png
Chào thầy!
Thầy cho em hỏi là file mà thầy gửi lên chạy bằng ms office thì được nhưng nếu chạy bằng kingsoft thì bị lỗi như vầy,thấy có thế giải thích cho em biết là nguyên nhân là gì được không ạ?
 
Upvote 0
Cu Tồ đã viết:
View attachment 241809
Chào thầy!
Thầy cho em hỏi là file mà thầy gửi lên chạy bằng ms office thì được nhưng nếu chạy bằng kingsoft thì bị lỗi như vầy,thấy có thế giải thích cho em biết là nguyên nhân là gì được không ạ?
Nhấp chuột vào đây để mở rộng...
Tôi không biết kingsoft đâu bạn, nhưng khả năng cao là kingsoft chỉ tương thích với VB6? Chắc là vậy!
 
Upvote 0
ndu96081631 đã viết:
Tôi không biết kingsoft đâu bạn, nhưng khả năng cao là kingsoft chỉ tương thích với VB6? Chắc là vậy!
Nhấp chuột vào đây để mở rộng...
Vâng,em cảm ơn,tại vì em thử chạy bằng kingsoft thì báo lỗi thiếu sub hoặc function ở chỗ em bôi đỏ.chắc do không tương thích thì phải
 
Upvote 0
Cu Tồ đã viết:
Vâng,em cảm ơn,tại vì em thử chạy bằng kingsoft thì báo lỗi thiếu sub hoặc function ở chỗ em bôi đỏ.chắc do không tương thích thì phải
Nhấp chuột vào đây để mở rộng...
Bạn có thể sửa mấy hàm API ấy thành:
Mã: 
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 lCount As Long, hWnd As Long
rồi thử lại xem có lỗi gì nữa không?
 
Upvote 0
ndu96081631 đã viết:
Bạn có thể sửa mấy hàm API ấy thành:
Mã: 
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 lCount As Long, hWnd As Long
rồi thử lại xem có lỗi gì nữa không?
Nhấp chuột vào đây để mở rộng...
Chạy ngon luôn thầy ạ！ ·Cảm ơn thầy nhiều.đúng là thầy biết nhiều thật
Bài đã được tự động gộp:

rồi thử lại xem có lỗi gì nữa không?
[/QUOTE]
Em thấy thầy bỏ PtrSafe đi và đổi LongPtr thành long .thầy có thể cho em biết PtrSafe này có tác dụng gì trong hàm cũ không ạ?
Bài đã được tự động gộp:

Và nếu có thời gian thầy cho em hỏi là nếu em muốn giữ cả hai hàm để khi mở bằng ms office hoặc kingsoft thì làm như thế nào để hai hàm này tự động thay thôi theo phần mềm đang mở ạ?
 
Lần chỉnh sửa cuối:
Upvote 0
Cu Tồ đã viết:
Em thấy thầy bỏ PtrSafe đi và đổi LongPtr thành long .thầy có thể cho em biết PtrSafe này có tác dụng gì trong hàm cũ không ạ?
Nhấp chuột vào đây để mở rộng...
Cái này là nguyên tắc do MS đặt ra chứ không phải muốn thay thế nào thì thay. Tùy theo hệ thống 32 hoặc 64 bit mà thay đổi thích hợp.
Bạn có thể tham khảo ở đây:

VBA Visual Basic Editor - VBA 7.0

description
bettersolutions.com bettersolutions.com
 
Upvote 0
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
7
Đọc
130
yaaasoo01
Y
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
Trả lời
10
Đọc
67
LuuAnh980
LuuAnh980
A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
9
Đọc
139
Hoàng Tuấn 868
H
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
27
Đọc
2K
ngochienbmt
N
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
8
Đọc
91
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom