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

[1+1=2]

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



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

Cháu xin chân thành cảm ơn ạ

 

[ndu96081631]

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 ạ

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:

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

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!

 

[1+1=2]

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:

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

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!

Cháu cảm ơn chú nhiều lắm. Code rất ưng ý luôn ạ

 

[Cu 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:

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

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!

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 ạ?

 

[ndu96081631]

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 ạ?

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!

 

[Cu 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!

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

 

[ndu96081631]

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

Bạn có thể sửa mấy hàm API ấy thành:

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?

 

[Cu Tồ]

Bạn có thể sửa mấy hàm API ấy thành:

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?

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: 25/7/20

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: 25/7/20

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ở ạ?

 

[ndu96081631]

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 ạ?

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

 

[Cu Tồ]

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

cảm ơn thầy nhiều ạ