Cách đóng hộp MsgBox tự động? (1 người xem)

PhanTuHuong · 5/1/07

Tôi muốn hộp thông báo tự động đóng sau một khoảng thời gian nhất định, không biết có thực hiện được không?

Tôi đã làm đối với UserForm thì ổn. Còn anh MsgBox thì chưa biết thế nào?

Davidsy · 5/1/07

Không biết bên VBA có lênh Sendkey không? Bạn tìm hiểu thử ...

ruadangyeu · 5/1/07

Theo mình cái này có lẽ không thực hiện được vì
Đối với userform thì ta có thể dùng control time để đếm thời gian sau đó cho ẩn form đi(nếu form của bạn không để ở modal) còn với msgbox thì nó luôn ở chế độ modal tức là việc thực thi mã sẽ ngừng lại cho đến khi người dùng thực thi lựa chọn xong, điều đố đồng nghĩa với việc khi msg hiện ra thì không có câu lệnh nào được thực hiện song song với nó(Cái này còn gọi là đa mạch trình)

Mong các cao thủ chỉ bảo thêm

Nguyễn Duy Tuân · 5/1/07

Cái này phải dùng kỹ thuật SUBCLASS (lập trình API). Viết thủ tục WinPro, trong đó kiểm tra thông điệp WM_TIMER.
Nếu không thực sự cần thì anh nên dùng Userform cho dễ và nhanh chứ can thiệp API phức tạp lắm.

hai2hai · 5/1/07

Google: Auto Close Msgbox Visual Basic

quangiang · 18/1/07

Đóng hộp msgbox tự động

Chào các bạn.
Tôi có File này thực hiện được yêu cầu của bạn . xin tham khảo File msgbox.xls đính kèm .
Rất vui khi được tham gia cùng các bạn
Xin tham khảo đoạn mả sau:

Mã:

[FONT="Courier New"]Public Const NV_CLOSEMSGBOX As Long = &H5000&
Public Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&, _
ByVal uElapse&, ByVal lpTimerFunc&)
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName$, ByVal lpWindowName$)
Public Declare Function LockWindowUpdate& Lib "user32" (ByVal hwndLock&)
Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hWnd&)
Public Declare Function MessageBox& Lib "user32" Alias "MessageBoxA" _
(ByVal hWnd&, ByVal lpText$, ByVal lpCaption$, ByVal wType&)
Public Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&)
Public Const API_FALSE As Long = 0&
Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
    KillTimer hWnd, idEvent
    Dim hMessageBox&
    hMessageBox = FindWindow("#32770", "Thong bao")
    If hMessageBox Then
        Call SetForegroundWindow(hMessageBox)
        SendKeys "{enter}"
    End If
    Call LockWindowUpdate(API_FALSE)
End Sub
Public Sub TuDong()
  SetTimer hWnd, NV_CLOSEMSGBOX, 3000&, AddressOf TimerProc
    Call MessageBox(hWnd, "Dang tong hop so lieu , xin cho...", _
    "Thong bao", MB_ICONQUESTION Or MB_TASKMODAL)
End Sub
[/FONT]

xluan · 3/9/10

Code đóng hộp MsgBox tự động

Mình có file nhập liệu, trong quá trình thi hành có hiện MsgBox, làm thế nào để tự động đóng hộp MsgBox sau 1s. Mình không rành về Code xin các cao thủ chỉ dùm. thanks

ndu96081631 · 3/9/10

xluan đã viết:
Mình có file nhập liệu, trong quá trình thi hành có hiện MsgBox, làm thế nào để tự động đóng hộp MsgBox sau 1s. Mình không rành về Code xin các cao thủ chỉ dùm. thanks

Code của bạn có đoạn
MsgBox "Dang o dong " & iRow
Hãy sửa nó thành:
CreateObject("WScript.Shell").Popup "Dang o dòng " & iRow, 1, "THÔNG BÁO"
Code này tuy đơn giản nhưng có 1 nhược điểm: Con trỏ chuột phải đặt trong khu vực của MsgBox thì nó mới tự tắt

thanhlanh · 3/9/10

ndu96081631 đã viết:
Code của bạn có đoạn
MsgBox "Dang o dong " & iRow
Hãy sửa nó thành:
CreateObject("WScript.Shell").Popup "Dang o dòng " & iRow, 1, "THÔNG BÁO"
Code này tuy đơn giản nhưng có 1 nhược điểm: Con trỏ chuột phải đặt trong khu vực của MsgBox thì nó mới tự tắt

Hộp thông báo này rất hay nhưng nếu bây giờ chọn thời gian là n giây tùy ý, nó hiện thời gian đếm ngược về 0 rồi tắt thông báo thì hay nữa anh ndu nhỉ?

ndu96081631 · 3/9/10

thanhlanh đã viết:
Hộp thông báo này rất hay nhưng nếu bây giờ chọn thời gian là n giây tùy ý, nó hiện thời gian đếm ngược về 0 rồi tắt thông báo thì hay nữa anh ndu nhỉ?

Tôi nghĩ là làm được nhờ vào hàm SetTimer. Thuật toán có thể là:
- Gán 1 biến iT nào đó (là thời gian đóng MsgBox)
- Khi MsgBox xuất hiện, sau 1s ta tắt MsgBox đi, đồng thời trừ iT bớt 1 đơn vị
- Lại cho MsgBox xuất hiện ...
- Cứ tiếp tục như thế đến khi iT = 0 thì KillTimer
Nghĩ vậy thôi nhưng viết ra cũng không phải là dễ ăn đâu
----------------
Cách đơn giản nhất là dùng 1 UserForm giả lập MsgBox
Hic....

Ếch Xanh · 3/9/10

xluan đã viết:
Mình có file nhập liệu, trong quá trình thi hành có hiện MsgBox, làm thế nào để tự động đóng hộp MsgBox sau 1s. Mình không rành về Code xin các cao thủ chỉ dùm. thanks

Từ Nguồn CODE của bạn quangiang, tôi làm cái msgbox tự động thoát sau khi nhập liệu xong.

Có thể thay Sendkey (ENTER) thành ESC (Tôi nghĩ ESC hay hơn vì nó có giá trị thoát)

PHP:

Public Const NV_CLOSEMSGBOX As Long = &H5000&
Public Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&, _
ByVal uElapse&, ByVal lpTimerFunc&)
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName$, ByVal lpWindowName$)
Public Declare Function LockWindowUpdate& Lib "user32" (ByVal hwndLock&)
Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hWnd&)
Public Declare Function MessageBox& Lib "user32" Alias "MessageBoxA" _
(ByVal hWnd&, ByVal lpText$, ByVal lpCaption$, ByVal wType&)
Public Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&)
Public Const API_FALSE As Long = 0&
Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
    KillTimer hWnd, idEvent
    Dim hMessageBox&
    hMessageBox = FindWindow("#32770", "Thong bao")
    If hMessageBox Then
        Call SetForegroundWindow(hMessageBox)
        SendKeys "{Esc}"
    End If
    Call LockWindowUpdate(API_FALSE)
End Sub
Public Sub NhapLieu()
Application.ScreenUpdating = False
On Error Resume Next
  SetTimer hWnd, NV_CLOSEMSGBOX, 900&, AddressOf TimerProc
  Dim STT As Long
  STT = WorksheetFunction.Max(Range(Data.[a3], Data.[a65536].End(xlUp))) + 1
  Form.[B2].Value = STT
 
  Call MessageBox(hWnd, "Dang o dong " & STT, _
  "Thong bao", MB_ICONQUESTION Or MB_TASKMODAL)
 
  Form.[B2:B8].Copy
  Dim NextRow As Long
  NextRow = Data.[a65536].End(xlUp).Row + 1
  Data.Cells(NextRow, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
  Application.CutCopyMode = False
  Form.Select: [B3].Select
Application.ScreenUpdating = True
End Sub

Bạn xem File đính kèm nhé! Tôi nghĩ đúng yêu cầu của bạn đấy!

À, bạn muốn nó hiện nhanh hay chậm là do cái này quyết định nha:

SetTimer hWnd, NV_CLOSEMSGBOX, 900&, AddressOf TimerProc

Nếu số càng lớn thì càng chậm và ngược lại. Ví dụ nhanh hơn, bạn có thể thay thành: 600&

Ếch Xanh · 4/9/10

Phải chi cái MsgBox tự động đóng lại cũng xài như cai UniMsgBox của các Thầy trên diễn đàn thì hay biết mấy. Tôi chẳng biết gì về API nên mày mò chẳng được.

PHP:

Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Function UniMsgBox(ByVal Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title As String = vbNullString, Optional ByVal HelpFile As String = vbNullString, Optional ByVal Context) As VbMsgBoxResult
  UniMsgBox = MessageBox(GetActiveWindow, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function

Bởi vì cái Sub TimerProc tự động đóng dưới đây lệ thuộc vào cấu trúc quá, ví như chữ "Thông báo" nếu thay bằng chữ khác thì nó cũng đứng im không thể tự đóng lại được!
hMessageBox = FindWindow("#32770", "Thông báo")

PHP:

Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
    KillTimer hWnd, idEvent
    Dim hMessageBox&
    hMessageBox = FindWindow("#32770", "Thông báo")
    If hMessageBox Then
        Call SetForegroundWindow(hMessageBox)
        SendKeys "{Esc}"
    End If
    Call LockWindowUpdate(API_FALSE)
End Sub

Kính mong các Thầy có giải pháp nào khác không? Có thể thay Sub TimerProc thành Function TimerProc được không?

ndu96081631 · 4/9/10

Learning_Excel đã viết:
Phải chi cái MsgBox tự động đóng lại cũng xài như cai UniMsgBox của các Thầy trên diễn đàn thì hay biết mấy. Tôi chẳng biết gì về API nên mày mò chẳng được.

PHP:

Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long Public Function UniMsgBox(ByVal Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title As String = vbNullString, Optional ByVal HelpFile As String = vbNullString, Optional ByVal Context) As VbMsgBoxResult UniMsgBox = MessageBox(GetActiveWindow, StrPtr(Prompt), StrPtr(Title), Buttons) End Function

Bởi vì cái Sub TimerProc tự động đóng dưới đây lệ thuộc vào cấu trúc quá, ví như chữ "Thông báo" nếu thay bằng chữ khác thì nó cũng đứng im không thể tự đóng lại được!
hMessageBox = FindWindow("#32770", "Thông báo")

PHP:

Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&) KillTimer hWnd, idEvent Dim hMessageBox& hMessageBox = FindWindow("#32770", "Thông báo") If hMessageBox Then Call SetForegroundWindow(hMessageBox) SendKeys "{Esc}" End If Call LockWindowUpdate(API_FALSE) End Sub

Kính mong các Thầy có giải pháp nào khác không? Có thể thay Sub TimerProc thành Function TimerProc được không?

Viết vầy nè đồng chí ơi:

PHP:

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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private sLastTitle As String

PHP:

Public Function AutoCloseMsg(iT As Long, prompt As String, Optional buttons As Long, Optional title As String) As Long
  sLastTitle = title
  SetTimer Application.hWnd, 0, iT * 1000, AddressOf TimerProc
  AutoCloseMsg = MsgBox(prompt, buttons, title)
End Function

PHP:

Private Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
  KillTimer Application.hWnd, 0
  If FindWindow("#32770", sLastTitle) Then Application.SendKeys "{ENTER}"
  sLastTitle = vbNullString
  KillTimer Application.hWnd, 0
End Function

Sub hay Function chẳng quan trọng gì
Thêm nữa:
- Tiêu đề là THÔNG BÁO hay THÔNG thứ quái gì cũng đựoc!
- Cũng không cần dùng MsgBox của Windows, bất cứ thứ gì có dạng MsgBox đều dùng đựoc!

Ếch Xanh · 4/9/10

ndu96081631 đã viết:

Viết vầy nè đồng chí ơi:

PHP:

Sub hay Function chẳng quan trọng gì
Thêm nữa: 
- Tiêu đề là THÔNG BÁO hay THÔNG thứ quái gì cũng đựoc!
- Cũng không cần dùng MsgBox của Windows, bất cứ thứ gì có dạng MsgBox đều dùng đựoc![/QUOTE]
 
Thầy thật tuyệt vời, em Cám Ơn Thầy!
 
Thầy ơi, nếu như vậy, có thể làm cho nó hiểu Unicode không vậy Thầy?

ndu96081631 · 4/9/10

Learning_Excel đã viết:
Thầy thật tuyệt vời, em Cám Ơn Thầy!

Thầy ơi, nếu như vậy, có thể làm cho nó hiểu Unicode không vậy Thầy?

Thì thử đi xem thế nào!
Unicode MsgBox đã nói nhiều lần trên diển đàn rồi mà
Ví dụ vầy:

PHP:

Public Function AutoCloseMsg(iT As Long, prompt As String, Optional buttons As Long, Optional title As String) As Long
  sLastTitle = title
  SetTimer Application.hWnd, 0, iT * 1000, AddressOf TimerProc
  AutoCloseMsg = CreateObject("WScript.Shell").Popup(prompt, , title, buttons)
End Function

và

PHP:

Sub Nhap()
  .......
    AutoCloseMsg 2, ChrW(272) & "ang " & ChrW(7903) & " dòng " & iRow, 0, "THÔNG BÁO"
  ......
End Sub

Ếch Xanh · 4/9/10

ndu96081631 đã viết:
Thì thử đi xem thế nào!
Unicode MsgBox đã nói nhiều lần trên diển đàn rồi mà
Ví dụ vầy:

PHP:

Public Function AutoCloseMsg(iT As Long, prompt As String, Optional buttons As Long, Optional title As String) As Long sLastTitle = title SetTimer Application.hWnd, 0, iT * 1000, AddressOf TimerProc AutoCloseMsg = CreateObject("WScript.Shell").Popup(prompt, , title, buttons) End Function

và

PHP:

Sub Nhap() ....... AutoCloseMsg 2, ChrW(272) & "ang " & ChrW(7903) & " dòng " & iRow, 0, "THÔNG BÁO" ...... End Sub

Em thử rồi, Nếu nội dung thay đổi, thậm chí tham chiếu từ 1 cell thì nó hiểu và chạy tốt, nhưng thử thay Title (caption) từ tham chiếu tại 1 cell hoặc chuyển mã như Thầy thì nó bí rị à Thầy ui. VD như vầy là nó bí nè Thầy:

AutoCloseMsg 2, Form.[G2].Value, 0, ChrW(272) & "ang " & ChrW(7903) & " dòng "

hoặc:

AutoCloseMsg 2, Form.[G2].Value, 0, Form.[G2].Value

Nhưng như vầy thì được:

AutoCloseMsg 2, Form.[G2].Value, 0, "THÔNG BÁO"

Nghĩ cũng lạ thật! Nhưng với hàm của Thầy thì nó hiểu Unicode hết!

ndu96081631 · 4/9/10

Learning_Excel đã viết:
Em thử rồi, Nếu nội dung thay đổi, thậm chí tham chiếu từ 1 cell thì nó hiểu và chạy tốt, nhưng thử thay Title (caption) từ tham chiếu tại 1 cell hoặc chuyển mã như Thầy thì nó bí rị à Thầy ui.!

Các loại MsgBox mà ta từng biết trên Excel, chẳng có cái nào có thể viết tiếng Việt Unicode trên Title cả
Muốn hoàn hảo thì dùng MsgBox của Windows đi!
(chữ THÔNG BÁO nó hiện đựoc là vì... hên ---> ký tự Ô có charcode = 212, ký tự Á có charcode = 193... đều < 255)

Ếch Xanh · 4/9/10

ndu96081631 đã viết:
Các loại MsgBox mà ta từng biết trên Excel, chẳng có cái nào có thể viết tiếng Việt Unicode trên Title cả
Muốn hoàn hảo thì dùng MsgBox của Windows đi!
(chữ THÔNG BÁO nó hiện đựoc là vì... hên ---> ký tự Ô có charcode = 212, ký tự Á có charcode = 193... đều < 255)

Em thì ứng dụng cái có sẳn để mày mò, vọc phá là chủ yếu, cho nên em thấy cái code dưới đây nó có thể tham chiếu tại cell được. (Mà code của Thầy cũng hiểu Unicode ở Caption, nhưng nó không chạy Close thôi).

Mã:

[COLOR=#000000][COLOR=#0000bb][/COLOR][SIZE=3][FONT=Courier New][COLOR=#007700]Private Declare Function [/COLOR][COLOR=#0000bb]GetActiveWindow Lib [/COLOR][COLOR=#dd0000]"user32" [/COLOR][COLOR=#007700]() As [/COLOR][/FONT][/SIZE][SIZE=3][FONT=Courier New][COLOR=#0000bb]Long
[/COLOR][COLOR=#007700]Private Declare Function [/COLOR][COLOR=#0000bb]MessageBoxW Lib [/COLOR][COLOR=#dd0000]"user32" [/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]ByVal hWnd [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Long[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]ByVal lpText [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]String[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]ByVal lpCaption [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]String[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]ByVal wType [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Long[/COLOR][COLOR=#007700]) As [/COLOR][/FONT][/SIZE][SIZE=3][FONT=Courier New][COLOR=#0000bb]Long
[/COLOR][COLOR=#007700][/COLOR][/FONT][/SIZE][/COLOR]
[COLOR=#000000][SIZE=3][FONT=Courier New][COLOR=#007700]Public Function [/COLOR][COLOR=#0000bb]UniMsgBox[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]ByVal Prompt [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]String[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Optional ByVal Buttons [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]VbMsgBoxStyle [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]vbOKOnly[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Optional ByVal Title [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]String [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]vbNullString[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Optional ByVal HelpFile [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]String [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]vbNullString[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Optional ByVal Context[/COLOR][COLOR=#007700]) As [/COLOR][/FONT][/SIZE][SIZE=3][FONT=Courier New][COLOR=#0000bb]VbMsgBoxResult
  UniMsgBox [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]MessageBox[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]GetActiveWindow[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]StrPtr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Prompt[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#0000bb]StrPtr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Title[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#0000bb]Buttons[/COLOR][/FONT][/SIZE][SIZE=3][FONT=Courier New][COLOR=#007700])
[/COLOR][COLOR=#0000bb]End [/COLOR][/FONT][/SIZE][COLOR=#007700][FONT=Courier New][SIZE=3]Function  [/SIZE][/FONT]
[/COLOR][COLOR=#0000bb][/COLOR][/COLOR]

Ếch Xanh · 4/9/10

Nếu làm bằng UserForm thì dễ quá phải không Thầy, muốn gì cũng được! Em thì làm như vầy, không biết Thầy có chỉ em thêm không:

PHP:

Private Sub UserForm_Activate()
  dem
End Sub
 
Sub dem()
  Dim i As Long
  For i = 0 To 100
    Label2.Caption = i
    Sleep 15
    'Me.Repaint
    DoEvents
    If Label2.Caption = 100 Then Unload Me
  Next i
End Sub

ndu96081631 · 4/9/10

Learning_Excel đã viết:
Nếu làm bằng UserForm thì dễ quá phải không Thầy, muốn gì cũng được! Em thì làm như vầy, không biết Thầy có chỉ em thêm không:

PHP:

Private Sub UserForm_Activate() dem End Sub Sub dem() Dim i As Long For i = 0 To 100 Label2.Caption = i Sleep 15 'Me.Repaint DoEvents If Label2.Caption = 100 Then Unload Me Next i End Sub

Thì đúng vậy! UserForm dễ hơn!
Vấn đề là bạn vẫn dùng Sleep thì chẳng hay tí nào ---> Cố gắng SetTimer xem ---> Hàm này tuyệt cú mèo, nhưng cũng hơi khó dùng

Cách đóng hộp MsgBox tự động? (1 người xem)

Người dùng đang xem chủ đề này

VBA & VB.NET for Excel & AutoCad

Thành viên mới

Wise after the event

Nghị Hách

VNUNi®

Thành viên mới

Thành viên mới

File đính kèm

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Thành viên tích cực

Huyền thoại GPE

File đính kèm

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Sinh nhật lần 19 GPE