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

Ếch Xanh · 4/9/10

ndu96081631 đã viết:
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

Ngoài cái code đó của em ra còn có cái này nữa là em làm được:

PHP:

Private Sub Dem2()
  Dim SetTime As Double, kt As Double
  SetTime = TimeSerial(0, 0, 2)   'Hoac TimeValue("00:00:2")
  Do
    Label3.Caption = Format(SetTime, "HH:mm:ss")
    SetTime = SetTime - TimeValue("00:00:01")
    kt = Timer
    Do While Timer - kt < 1
      DoEvents
      If Label3.Caption = "00:00:00" Then: Unload Me: Exit Sub
    Loop
  Loop
End Sub
 
Private Sub UserForm_Activate()
  Dem2
End Sub

Chứ SetTimer như Thầy nói thì em bó cái tay:

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

ndu96081631 · 5/9/10

Learning_Excel đã viết:
Chứ SetTimer như Thầy nói thì em bó cái tay:

Tặng đồng chí đây:
1> Trong UserForm

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 hT As Double
  iT = 50: Total = iT: sWidth = Label2.Width / iT
  hT = Me.Height - Me.InsideHeight
  hWnd = FindWindow("ThunderDFrame", Me.Caption)
  SetWindowLong hWnd, -16, &H84080080
  Me.Height = Me.Height - hT
End Sub

2> Trong Module

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
Public iT As Long, Total As Long, hWnd As Long, sWidth As Double

PHP:

Private Sub ACForm()
  With UserForm1
    .Label1.Caption = .Label4.Caption & Int(iT / 10) + 1 & " giây sau nhé!.. Ec.. Ec.."
    .Label2.Width = sWidth * iT
    .Label3.ForeColor = IIf(Int(iT / 5) Mod 2, &H8000000E, &HFF&)
  End With
  If (iT Mod 10) = 0 Then Beep
  iT = iT - 1
  If iT = 0 Then
    StopMsg
    Unload UserForm1
  End If
End Sub

PHP:

Sub StartMsg()
  StopMsg
  UserForm1.Show
  SetTimer hWnd, 0, 100, AddressOf ACForm
End Sub

PHP:

Sub StopMsg()
  KillTimer hWnd, 0
  Unload UserForm1
End Sub

Cái MsgBox giả lập ấy có hình dáng thế này

Xem code chẳng có vòng lập nào đâu nhé ---> Cái SetTimer nó điều khiển tất, đến khi gọi KillTimer thì dừng
Cái hay của SetTimer là khi chạy nó chẳng ảnh hưởng đến bất kỳ công việc nào của ta cả (tức nó chạy, nó cứ chạy... Việc ta, ta cứ làm...)
Chạy thử file xem ngon lành không?
(File hoàn tất với sự gợi ý của Nguyễn Duy Tuân)

ongtrungducmx25 · 16/9/10

ndu96081631 đã viết:
Tặng đồng chí đây:
1> Trong UserForm

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 hT As Double iT = 50: Total = iT: sWidth = Label2.Width / iT hT = Me.Height - Me.InsideHeight hWnd = FindWindow("ThunderDFrame", Me.Caption) SetWindowLong hWnd, -16, &H84080080 Me.Height = Me.Height - hT End Sub

2> Trong Module

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 Public iT As Long, Total As Long, hWnd As Long, sWidth As Double

PHP:

Private Sub ACForm() With UserForm1 .Label1.Caption = .Label4.Caption & Int(iT / 10) + 1 & " giây sau nhé!.. Ec.. Ec.." .Label2.Width = sWidth * iT .Label3.ForeColor = IIf(Int(iT / 5) Mod 2, &H8000000E, &HFF&) End With If (iT Mod 10) = 0 Then Beep iT = iT - 1 If iT = 0 Then StopMsg Unload UserForm1 End If End Sub

PHP:

Sub StartMsg() StopMsg UserForm1.Show SetTimer hWnd, 0, 100, AddressOf ACForm End Sub

PHP:

Sub StopMsg() KillTimer hWnd, 0 Unload UserForm1 End Sub

Cái MsgBox giả lập ấy có hình dáng thế này

View attachment 51703

Xem code chẳng có vòng lập nào đâu nhé ---> Cái SetTimer nó điều khiển tất, đến khi gọi KillTimer thì dừng
Cái hay của SetTimer là khi chạy nó chẳng ảnh hưởng đến bất kỳ công việc nào của ta cả (tức nó chạy, nó cứ chạy... Việc ta, ta cứ làm...)
Chạy thử file xem ngon lành không?
(File hoàn tất với sự gợi ý của Nguyễn Duy Tuân)

thêm đoạn mã code vào ThisWorkbook:

PHP:

Option Explicit
Private Sub Workbook_open()
 On Error Resume Next
    UserForm1.Show
End Sub

thì nó hiện lên UF rồi đứng ở đó lên không thấy run gì cả !

ndu96081631 · 16/9/10

ongtrungducmx25 đã viết:
thêm đoạn mã code vào ThisWorkbook:

PHP:

Option Explicit Private Sub Workbook_open() On Error Resume Next UserForm1.Show End Sub

thì nó hiện lên UF rồi đứng ở đó lên không thấy run gì cả !

Đồng chí này máy móc quá ---> Đâu phải show form lên là nó chạy đâu ---> Trước đó nó còn làm vài thứ khác cơ mà
Hic...
Muốn tự động mở form khi file khởi động, chỉ việc sửa tên sub StartMsg thành Autpen thì xong
Còn muốn dùng sự kiện Workbook_open thì phải thế này:

PHP:

Private Sub Workbook_open()
  StartMsg
End Sub

yeudoi · 7/3/11

Mình tìm thấy được cái này hiển thị thông báo đơn giản và có thể đóng lại theo thời gian hẹn trước gửi mọi người tham khảo.

ndu96081631 · 7/3/11

yeudoi đã viết:
Mình tìm thấy được cái này hiển thị thông báo đơn giản và có thể đóng lại theo thời gian hẹn trước gửi mọi người tham khảo.

Dùng WScript.Shell mình đã từng nói nhiều lần rồi mà
Chẳng hạn tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?38289-H%C3%A0m-ChrW-hi%E1%BB%83n-th%E1%BB%8B-kh%C3%B4ng-ch%C3%ADnh-x%C3%A1c&
MsgBox loại này còn có khả năng hiển thị được tiếng Việt Unicode nữa đấy
(có điều cái chức năng hẹn giờ thì không mấy ổn định)

luckylucke_2009 · 21/7/15

Nhờ các Bác sửa lỗi giúp em.
Sau khi em khai báo lại các hàm "user32"

File "Form_CountDown_2.xlsm" đã chạy được rồi. Nhưng sau khi đã xuất lệnh chạy thì vào VBA chỉnh sửa chương trình thì Excel bị treo.

Glk.ninhthuan · 11/9/15

Chạy trên Win64 báo lỗi. Mong Anh chỉ dùm

langtuchungtinh360 · 27/2/17

em có được một thanh viên cao thủ chỉ thêm cách tạo msgbox tự động đóng nhưng khi không chọn gì thì giá trị nó luôn là -1
vậy có cách nào cho nó chọn một trong các nút mình định sẵn được không ạ
em có chỉnh sửa lại thế này

PHP:

Public Function UniMsgbox(Optional NoiDung As String = "", _
            Optional TieuDe As String = "Thông Báo", _
            Optional ThoiGianDong As Byte = 1, _
            Optional KieuNutLenh As Byte = 0, _
            Optional KieuIcon As Byte = 0, _
            Optional LenhMacDinh As Byte = 1)
Rem     'KieuNutLenh:   0   -OK     | 1 -OK Cancel  | 2 - Abort Retry Ignore    | 3 - Yes No CanCel     | 4- Yes No | 5- Retry Cancel
Rem     'KieuIcon:      16  -(X)    | 32-(?)        | 48-/!\                    | 64-(!)                | 0-....
Rem     'UniMsgbox:     1   -OK     | 2 - Cancel    | 3 - Abort                 | 4 - Retry             | 5- Ignore | 6- Yes    | 7- No
    LenhMacDinh = WorksheetFunction.Min(WorksheetFunction.Max(LenhMacDinh, 1), 3)
    UniMsgbox = CreateObject("Wscript.shell").PopUp(NoiDung, ThoiGianDong, TieuDe, KieuNutLenh + KieuIcon + (LenhMacDinh - 1) * 256)
If UniMsgbox = -1 And KieuNutLenh > 0 Then
    Dim Arr As Variant
    Arr = Switch(LenhMacDinh = 1, Array(1, 3, 6, 6, 4), LenhMacDinh = 2, Array(2, 4, 7, 7, 2), LenhMacDinh = 3, Array(2, 5, 2, 7, 2))
    UniMsgbox = Arr(KieuNutLenh - 1)
End If
End Function


Sub TEST1()
Dim Arr As Variant
Arr = Array("", "OK", "Cancel", "Abort", "Retry", "Ignore", "Yes", "No")
UniMsgbox "Gia tri Msgbox tra ve : " & Arr(UniMsgbox("Dung Co Chon Gi Het Nha", "Test", 1, 3, 0, 1))
UniMsgbox "Gia tri Msgbox tra ve : " & Arr(UniMsgbox("Dung Co Chon Gi Het Nha", "Test", 1, 3, 0, 2))
UniMsgbox "Gia tri Msgbox tra ve : " & Arr(UniMsgbox("Dung Co Chon Gi Het Nha", "Test", 1, 3, 0, 3))
End Sub

mà thấy nó rườm rà chỗ tự xử lý sao ấy, có cách nào dễ hơn không ạ

dinhthientan · 26/12/17

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)

Kính gửi anh ndu96081631
Em có file tự động đóng MsgBox nhưng không thể đưa Unicode cho dòng thông báo được. Anh giúp em hiển thị tiếng Việt thì tốt quá.
Em sử dụng code này do khi chạy trên Form, khi MsgBox hiển thị, nếu mình không bấm OK mà bấm trực tiếp vào Form nó sẽ ẩn bảng MsgBox. Code này nó vẫn tiếp tục làm việc (sẽ tắt MsgBox) khi mình làm việc khác trên Form.
Cảm ơn anh nhiều

batman1 · 26/12/17

dinhthientan đã viết:
Em có file tự động đóng MsgBox nhưng không thể đưa Unicode cho dòng thông báo được. Anh giúp em hiển thị tiếng Việt thì tốt quá.

Thì dùng phiên bản W (phục vụ unicobe) thay cho phien bản A thôi. Tức dùng MessageBoxTimeoutW
Cho code sau vào 1 Modele riêng, vd. Module3

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrConv(message, vbUnicode), StrConv(Title, vbUnicode), flags, 0, timeout)
End Function

hoặc

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As Long, ByVal lpCaption As Long, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)
End Function

Code trong UserForm1 (xóa khai báo các hàm API đang có)

Mã:

Private Sub CommandButton1_Click()
    MsgBoxTimeout "Ch" & ChrW(7841) & "y th" & ChrW(7917) & Chr(10) & _
                    "N" & ChrW(7871) & "u " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & _
                    ChrW(7869) & " t" & ChrW(7921) & " t" & ChrW(7855) & "t", _
                    4000, "Thông báo", vbInformation
End Sub

dinhthientan · 26/12/17

batman1 đã viết:

Thì dùng phiên bản W (phục vụ unicobe) thay cho phien bản A thôi. Tức dùng MessageBoxTimeoutW
Cho code sau vào 1 Modele riêng, vd. Module3

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrConv(message, vbUnicode), StrConv(Title, vbUnicode), flags, 0, timeout)
End Function

hoặc

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As Long, ByVal lpCaption As Long, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As Long, ByVal lpCaption As Long, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)
End Function

Code trong UserForm1 (xóa khai báo các hàm API đang có)

Mã:

Private Sub CommandButton1_Click()
    MsgBoxTimeout "Ch" & ChrW(7841) & "y th" & ChrW(7917) & Chr(10) & _
                    "N" & ChrW(7871) & "u " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & _
                    ChrW(7869) & " t" & ChrW(7921) & " t" & ChrW(7855) & "t", _
                    4000, "Thông báo", vbInformation
End Sub

Hay quá. Em cảm ơn bác nhiều lắm.
Chỉ có điều, nếu dùng: MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)
thì ra toàn chữ Nhật hay TQ gì đấy.
Còn nếu dùng cái này: MsgBoxTimeout = MessageBoxTimeoutW(0, StrConv(message, vbUnicode), StrConv(Title, vbUnicode), flags, 0, timeout)
thì OK.

Em xin cảm ơn bác một lần nữa!

ThangCuAnh · 26/12/17

Code mình tương tự code của batman1, chỉ # chút xíu, đố ai tìm ra và tại sao

Cậu xóa hết code của UserForm1, pass code dưới vào, test thử nhen:

Mã:

#If VBA7 Then
Private Declare PtrSafe Function MessageBoxTimeout Lib "user32" _
        Alias "MessageBoxTimeoutW" (ByVal hWnd As LongPtr, _
            ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, _
            ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, _
            ByVal dwTimeout As Long) As Long
#Else
Private Declare Function MessageBoxTimeout Lib "user32" _
        Alias "MessageBoxTimeoutW" (ByVal hWnd As Long, _
            ByVal lpText As Long, ByVal lpCaption As Long, _
            ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, _
            ByVal dwTimeout As Long) As Long
#End If

Public Function MsgBoxUniTimeout(ByVal strText As String, ByVal strCaption As String, ByVal wType As VbMsgBoxStyle, ByVal dwTimeout As Long) As Long
    MsgBoxUniTimeout = MessageBoxTimeout(0, StrPtr(strText), StrPtr(strCaption), wType, 0, dwTimeout)
End Function

Private Sub CommandButton1_Click()
    Call MsgBoxUniTimeout("Ch" & ChrW(7841) & "y th" & ChrW(7917) & Chr(10) & _
        "N" & ChrW(7871) & "u " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & _
        ChrW(7869) & " t" & ChrW(7921) & " t" & ChrW(7855) & "t", "Thông báo", vbInformation, 6000)
End Sub

NguyenNgocThuHien · 26/12/17

ThangCuAnh đã viết:
#Else Private Declare PtrSafe

Khà khà, copy mà không sửa á, chạy trên 2007 thì gãy răng liền.

ThangCuAnh · 26/12/17

Hì hì, đang test trên Office 2010, x64, quên xóa.
Sữa rồi đó cô nương

batman1 · 26/12/17

dinhthientan đã viết:
Chỉ có điều, nếu dùng: MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)
thì ra toàn chữ Nhật hay TQ gì đấy.

Làm gì có

Tôi cho bạn 2 phiên bản.

Nếu dùng phiên bản 2 thì mới có
MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)

Nhưng với phiên bản 2 thì phải
#If VBA7 Then
Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
ByVal lpText As Long, ByVal lpCaption As Long, _
ByVal uType As Long, ByVal wLanguageId As Integer, _
ByVal dwMilliseconds As Long) As Long
#Else
Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
ByVal lpText As Long, ByVal lpCaption As Long, _
ByVal uType As Long, ByVal wLanguageId As Integer, _
ByVal dwMilliseconds As Long) As Long
#End If

Đã cố tình tách 2 phiên bản riêng rẽ nhau (để ở 2 [...code] ... [/...code] khác nhau), đọc mà không hiểu thì bótay.com

batman1 · 26/12/17

ThangCuAnh đã viết:
Code mình tương tự code của batman1, chỉ # chút xíu, đố ai tìm ra và tại sao

Tôi không biết bạn định nói về cái gì. Nhưng bạn để ý là tôi đưa ra 2 phiên bản
- lpText As String + StrConv
- lpText As Long + StrPtr

ThangCuAnh · 26/12/17

Function StrPtr(Ptr As String) As LongPtr
Member of VBA._HiddenModule
Trên x86, LongPtr = Long
Trên x64, LongPtr = LongLong
Pointer, handle... trong win64 luôn là 64 bit size.

batman1 · 26/12/17

Đúng là quên. Ở trên là LongPtr, ở dưới là Long. Đã sửa ở bài đầu

ThangCuAnh · 26/12/17

BSTR to and from a DLL: Visual Basic - Visual C++/Delphi...
Again from the MSDN documentation (in a remote part of it, to be honest !), we read what follows:

Visual Basic always creates a new BSTR containing ANSI characters (not UNICODE ones!) when passing a string to a DLL
Visual Basic always gets a BSTR containing UNICODE characters when getting a string from a DLL

This can be a problem, from the DLL point of view, as Visual C++ always exports and imports UNICODE strings.

So, the DLL must deal at runtime, with both the cases of input BSTR:

If called from a Visual Basic application: input BSTR contains ANSI characters
If called from a Visual C++ application: input BSTR contains UNICODE characters

Luckily enough, the DLL will always export BSTR with UNICODE characters.

Kiều Mạnh · 26/12/17

batman1 đã viết:

Thì dùng phiên bản W (phục vụ unicobe) thay cho phien bản A thôi. Tức dùng MessageBoxTimeoutW
Cho code sau vào 1 Modele riêng, vd. Module3

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrConv(message, vbUnicode), StrConv(Title, vbUnicode), flags, 0, timeout)
End Function

hoặc

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As Long, ByVal lpCaption As Long, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)
End Function

Code trong UserForm1 (xóa khai báo các hàm API đang có)

Mã:

Private Sub CommandButton1_Click()
    MsgBoxTimeout "Ch" & ChrW(7841) & "y th" & ChrW(7917) & Chr(10) & _
                    "N" & ChrW(7871) & "u " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & _
                    ChrW(7869) & " t" & ChrW(7921) & " t" & ChrW(7855) & "t", _
                    4000, "Thông báo", vbInformation
End Sub

Tham số 4000 = 4 giây sao Anh ... Em chưa hiểu tính kiểu gì ra 4000 ...... nếu được mong anh giải thích dùm
Em cảm ơn

ThangCuAnh · 26/12/17

Là mi li giây đó, dwMilliseconds

Kiều Mạnh · 26/12/17

ThangCuAnh đã viết:
Là mi li giây đó, dwMilliseconds

ok hiểu rồi ... Chính xác đến vậy sao

ByVal dwMilliseconds

batman1 · 26/12/17

kieu manh đã viết:
Tham số 4000 = 4 giây sao Anh ... Em chưa hiểu tính kiểu gì ra 4000 ...... nếu được mong anh giải thích dùm
Em cảm ơn

Tôi cố tình thay dwTimeout của người hỏi thành dwMilliseconds - một cái tên nói lên điều cụ thể.
Còn 4000 vì người ta muốn đóng sau 4 s mà.

NguyenNgocThuHien · 26/12/17

ThangCuAnh đã viết:
Pointer, handle... trong win64 luôn là 64 bit size.

Anh đang nói tới hệ điều hành hay đang nói tới phiên bản Excel vậy.

Trên mạng họ bảo thế này.

Function

StrPtr

String converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).

ThangCuAnh · 26/12/17

1. Hàm MessageBoxTimeout là hàm undocument của MS. Các hàm như MessageBox, MessageBoxEx... thực ra cuối cùng đều gọi tới hàm MessageBoxtTmeout này trong user32.dll, với dwMiliseconds = 0xFFFFFFFF
2. Từ VB/VBA mà gọi các hàm API xxxxxxA với ByVal param as String là 1 overhead cực kỳ nặng, tốn code, tốn time cho cả VB/VBA, cả cho các hàm nhân của Windows như ntdll, kernel32, user32....
Nếu được thì nên dùng các hàm API xxxxW

To NguyenNgocThuHien: như nhau cả, Office x64 chỉ chạy được trên Win 64.
Office x86 thì có thể chạy trên Win 64 và Win 32, nhưng vẫn là x86. Chạy trên Win64 nó chạy trên nền giả lập WOW64

NguyenNgocThuHien · 26/12/17

ThangCuAnh đã viết:
To NguyenNgocThuHien: như nhau cả, Office x64 chỉ chạy được trên Win 64.
Office x86 thì có thể chạy trên Win 64 và Win 32, nhưng vẫn là x86. Chạy trên Win64 nó chạy trên nền giả lập WOW64

Khác nhau chứ anh. Excel 32 bít cài trên win 64. Nhưng lúc đó strptr trả lại kiểu long ( như trên mạng kêu). Nên độ dài số bít của handle không hẳn chạy theo hệ điều hành? Nếu anh có máy 64 bít, cài excel32 bít thì thử xem, em không test được.

ThangCuAnh · 26/12/17

Hì hì, em đang nhầm lẫn giữa kiểu khai báo và kiểu dữ liệu thực đó.

Mã:

Dim lp as LongPtr
Dim l as Long
Dim ll as LongLong

Debug.Print LenB(lp)
Debug.Print LenB(l)
Debug.Print LenB(ll)

Mang đoạn code này test với các bản Excel 32, 64 đi.
Ví dụ máy tui, Office 2010 64bit, in ra là 8 4 8

NguyenNgocThuHien · 26/12/17

ThangCuAnh đã viết:
Hì hì, em đang nhầm lẫn giữa kiểu khai báo và kiểu dữ liệu thực đó.

Mã:

Dim lp as LongPtr Dim l as Long Dim ll as LongLong Debug.Print LenB(lp) Debug.Print LenB(l) Debug.Print LenB(ll)

Mang đoạn code này test với các bản Excel 32, 64 đi.

Độ dài của LongPtr thì em hiểu, nó chạy theo excel 32 hay 64 bít.

https://msdn.microsoft.com/en-us/library/office/ee691831(v=office.14).aspx

When should I use strptr, varpt, and objptr?

You should use these functions to retrieve pointers to strings, variables and objects, respectively. On the 64-bit version of Microsoft Office, these functions will return a 64-bit LongPtr, which can be passed to Declare statements. The use of these functions has not changed from previous versions of VBA. The only difference is that they now return a LongPtr.

Như trích dẫn trên thì nó khi nó vẫn có thể là 4 byte.

Em dùng 2007 nên không test có trên được, anh gửi kết quả luôn thì hay quá.

ThangCuAnh · 26/12/17

Trích từ Help của Excel

LongPtr Data Type
LongPtr (Long integer on 32-bit systems, LongLong integer on 64-bit systems) variables are stored as signed 32-bit (4-byte) numbers ranging in value from -2,147,483,648 to 2,147,483,647 on 32-bit systems; and signed 64-bit (8-byte) numbers ranging in value from -9,223,372,036,854,775,808 to 9,223,372,036,854,775,807 on 64-bit systems.

Note
LongPtr is not a true data type because it transforms to a Long in 32-bit environments, or a LongLong in 64-bit environments. Using LongPtr enables writing portable code that can run in both 32-bit and 64-bit environments. Use LongPtr for pointers and handles.

LongPtr - VBA now includes a variable type alias: LongPtr. The actual data type that LongPtr resolves to depends on the version of Office that it is running in: LongPtr resolves to Long in 32-bit versions of Office, and LongPtr resolves to LongLong in 64-bit versions of Office. Use LongPtr for pointers and handles.
LongLong – The LongLong data type is a signed 64-bit integer that is only available on 64-bit versions of Office. Use LongLong for 64-bit integrals. Conversion functions must be used to explicitly assign LongLong (including LongPtr on 64-bit platforms) to smaller integral types. Implicit conversions of LongLong to smaller integrals are not allowed.
PtrSafe – The PtrSafe keyword asserts that a Declare statement is safe to run in 64-bit versions of Office.

NguyenNgocThuHien · 26/12/17

ThangCuAnh đã viết:
LongPtr resolves to Long in 32-bit versions of Office, and LongPtr resolves to LongLong in 64-bit versions of Office

Có lẽ anh cũng nhầm rồi thì phải.
Kết quả trên excel32 bít, win64 bít.

NguyenNgocThuHien · 26/12/17

Rõ hơn một chút nữa.

ThangCuAnh · 26/12/17

Excel/Office của em là 32 bit, thì nó ra vậy là đúng rồi, chứ nhầm gì em ?

NguyenNgocThuHien · 27/12/17

ThangCuAnh đã viết:
Excel/Office của em là 32 bit, thì nó ra vậy là đúng rồi, chứ nhầm gì em ?

Có nghĩa là handle trên win 64bits vẫn phụ thuộc vào excel là 32 bít hay 64bits ý anh.

ThangCuAnh · 27/12/17

Ừ. Cứ hiểu nôm na là vậy đi, hiểu sâu hơn nữa thì nhức đầu, già đi đó em gái.
Khi nào rảnh thì em đọc thêm về WOW64 nhé:
https://msdn.microsoft.com/en-us/library/windows/desktop/aa384249(v=vs.85).aspx

Kiều Mạnh · 27/12/17

batman1 đã viết:
Tôi cố tình thay dwTimeout của người hỏi thành dwMilliseconds - một cái tên nói lên điều cụ thể.
Còn 4000 vì người ta muốn đóng sau 4 s mà.

Em thấy cùng 1 vấn đề là Tự đông Close Msgbox trong 1 khoãng thời gian cho trước ta có thể sử dụng:
1/ Hàm API như anh viết
2/ CreateObject("Wscript.shell").PopUp

Vậy Em muốn Hỏi:

1/ Vấn đề em muốn hỏi là giữa 2 cái đó có sự yêu việt gì khác biệt trong sử dụng tự động đóng Msgbox
2/ Nếu nó như nhau thì tại sao Bác Bill lại sinh 2 cái khác biệt vậy ???
3/ Sử dụng API hay CreateObject yêu việt hơn ... Hay yêu việt hơn trong trường hợp nào ?! Tại sao

Mong Anh chỉ thêm cho Em một chút để em hiểu sâu hơn một chút xử lý cùng một vấn đề ở nhiều góc độ khác nhau xem có gì khác

Em cảm ơn

batman1 · 27/12/17

kieu manh đã viết:
Em thấy cùng 1 vấn đề là Tự đông Close Msgbox trong 1 khoãng thời gian cho trước ta có thể sử dụng:
1/ Hàm API như anh viết
2/ CreateObject("Wscript.shell").PopUp

Vậy Em muốn Hỏi:

1/ Vấn đề em muốn hỏi là giữa 2 cái đó có sự yêu việt gì khác biệt trong sử dụng tự động đóng Msgbox
2/ Nếu nó như nhau thì tại sao Bác Bill lại sinh 2 cái khác biệt vậy ???
3/ Sử dụng API hay CreateObject yêu việt hơn ... Hay yêu việt hơn trong trường hợp nào ?! Tại sao

Mong Anh chỉ thêm cho Em một chút để em hiểu sâu hơn một chút xử lý cùng một vấn đề ở nhiều góc độ khác nhau xem có gì khác

Em cảm ơn

Cái này bạn tự kiểm nghiệm, so sánh thôi.
Tôi không dùng Popup, mà cũng chả bao giờ so sánh. Tôi không đam mê những vấn đề loại như thế.

VetMini · 27/12/17

kieu manh đã viết:
Em thấy cùng 1 vấn đề là Tự đông Close Msgbox trong 1 khoãng thời gian cho trước ta có thể sử dụng:
1/ Hàm API như anh viết
2/ CreateObject("Wscript.shell").PopUp

Vậy Em muốn Hỏi:

1/ Vấn đề em muốn hỏi là giữa 2 cái đó có sự yêu việt gì khác biệt trong sử dụng tự động đóng Msgbox
2/ Nếu nó như nhau thì tại sao Bác Bill lại sinh 2 cái khác biệt vậy ???
3/ Sử dụng API hay CreateObject yêu việt hơn ... Hay yêu việt hơn trong trường hợp nào ?! Tại sao

Mong Anh chỉ thêm cho Em một chút để em hiểu sâu hơn một chút xử lý cùng một vấn đề ở nhiều góc độ khác nhau xem có gì khác

Em cảm ơn

Tôi chả hiểu mô tê gì trong cái thớt này cả.
Nhưng câu 2 tôi có thể tạm trả lòi cho bạn:
- VBA là một ngôn ngữ dùng để hổ trợ Excel. Vì vậy Microsoft có quyền đặt nó như tạp pí lù. Và họ cũng bắt buộc phải cho nó tạp pí lù để có thể vừa ý nhiều tầng lớp, nhiều phiên bản (của office).
Vì vậy, nếu bạn có thấy 2 cái gì đó "như nhau" thì cứ như bài #57 nói; bạn tự nghĩ ra những trường hợp để test chúng. Có thể làn đầu bạn thấy lộng cộng và có thể mất cả tháng trời. Nhưng sau khi thử chừng vài chục lần, bạn sẽ quen và biết cách thử hiệu quả hơn.

Riêng cho VBScript (không phải VBA) thì thế này:
Ngôn ngữ Script dùng để hổ trợ quản lý máy và hệ điều hành cho nên nó chỉ thích ứng với giao diện đơn giản. Ba cái API phức tạp vốn chỉ nên dùng khi không còn cách nào khác.

Kiều Mạnh · 27/12/17

Mới phát hiện ra vầy chạy Code bài 31 xong xuất hiện Msgbox có nút OK nếu không chọn OK thì mặc định sau 4s nó tự thoát

1/ Vậy khi xuất hiện Msgbox thì ko chọn OK cứ để vậy và thao tác vài thứ linh tinh khác trên Sheet thì sau 4s nó cũng tự thoát
2/ Còn Với CreateObject("Wscript.shell").Popup thao tác như mục 1 thì nó vẫn cứ đơ ra đó hoài không thoát ............ tại sao ?
3/ Nếu ta không thao tác gì thêm thì CreateObject("Wscript.shell").Popup nó mới tự thoát .....Tại sao ta ???

Vậy là API nhiều khả năng chính xác hơn .Popup
Bạn nào rảnh test xem có đúng không ............. ,,,,,,,

.........Code két mà có quậy tanh bành ra mới thấy

ThangCuAnh · 28/12/17

Reverse ra thì dài dòng, nên em nói nôm na vầy thôi.
Wscript.Shell COM object được implement trong System32 (hay SysWOW64) wshom.ocx.
Method Popup được MS coder code nôm na như sau:
Function prototype:
virtual long __stdcall CWshShell:

opup(unsigned short *, struct tagVARIANT *, struct tagVARIANT *, struct tagVARIANT *, int *)
1. CreateThread với ThreadProc là 1 hàm ngắn, chỉ gọi MessageBoxW
2.Thực hiện Wait với timeout chỉ định = các hàm API sau: MsgWaitForMultipleObjects và parse message loop với PeekMessage, TranslateMessage, DispatchMessage
3. Trong trường hợp user click OK, Wait proc return, call GetExitCodeThread và CloseHandle cho thread vừa tạo.
4. User không click OK, msgbox vẫn còn display, gọi hàm EnumThreadWindows với hThread là handle của thread vừa tạo, trong EnumProc gọi PostMessage cho hWnd của thread đó, tức hWnd của MessageBoxW,
với uMsg = WM_QUIT, wParam = 0xABCDEFBB, lParam = 0
5. Xong, window của MessageBoxW đã mất, gọi WaitForSingleObject(hThread, INFINITE) cho ThreadProc ở trên thoát, thread thoát, gọi CloseHandle(hThread)
Xong method Popup.
Do phải sinh thread cho MessageBox, nên time schedule cho thread không còn chính xác khi user thực hiện các tác vụ khác, đẩy thread đó xuống không còn ưu tiên chiếm CPU time.
Nên các bạn thấy nó không đúng thời gian timeout là vậy.

Nguyễn Duy Tuân · 28/12/17

NguyenNgocThuHien đã viết:
Có nghĩa là handle trên win 64bits vẫn phụ thuộc vào excel là 32 bít hay 64bits ý anh.

Handle là ID của các thành phần

NguyenNgocThuHien đã viết:
Có nghĩa là handle trên win 64bits vẫn phụ thuộc vào excel là 32 bít hay 64bits ý anh.

Handle là ID do hệ điều hành tạo ra để nó quản lý. Hệ điều hành 64-bit thì sẽ sinh ra giá trị của Handle lớn trong miền giá trị của LongPtr. Excel hay các phần khác chỉ là khai báo biến có đủ khả năng nhận giá trị Handle thôi. Việc khai báo Long ở môi trường Excel 32, 64-bit vẫn có thể chạy được trong môi trường Windows 64-bit. Nhưng khả năng lỗi sẽ xảy ra nếu Windows 64 ngẫu nhiên sinh một giá trị Hangle lớn hơn khả năng lưu trữ của Long. Vì Excel 2010 trở lên có 2 phiên bản 32,64-bit nên Microsoft định hướng người lập trình VBA dùng LongPtr cho cả phiên bản 32, 64-bit để có khả năng đón nhận Handle nếu cài trên Windows 64-bit mà không bị Overfloat.

GIải thích thêm: mặc dù trong Excel 32-bit bạn tạo Userform nhưng thực chất Excel dùng hàm API của Windows để tạo, vú dụ
FormHandle = CreateWindowEx("ClassName",...)
Như vậy Windows 32-bit thì Handle sinh ra chắc chắn trong phạm vi biến kiểu Long, Windows 64-bit thì Handle sinh ra nằm trong phạm vi LongPtr (LongLong).
Windows 64-bit cho phép cài ứng dụng - Excel 32 hoặc 64-bit. Nên kiểu dữ liệu để nhận Handle nên khai báo LongPtr (LongPtr xét cho cùng chỉ là cái tên kiểu, giá trị của nó/handle như thế nào phụ thuộc vào nơi sinh ra giá trị trong nó - Hệ điều hành).

ThangCuAnh · 28/12/17

Nói rõ ra thì rất dài, phức tạp, nên Cu Anh em nói nôm na thế này:
Với ứng dụng 32 bit chạy trên Windows 64 bit, handle và pointer của app dài 32bit vẫn hợp lệ. WOW64 làm nhiệm vụ như 1 layer transparent cho ứng dụng 32 bit.
VD app 32 bit gọi API CreateWindow, lời gọi này không nhảy thẳng đến user32.dll, 1 dll core 64bit của Windows trong System32, mà nó được chuyển hướng tới user32.dll 32bit trong thư mục SysWOW64. Tại user32.dll 32bit, lời gọi CreateWindow sẽ được các dll core của Wow64 chuyển hướng sau khi modify các tham số input, làm tùm lum bà lằng, rồi switch OS mode từ 32 sang 64bit, rồi make call to CreateWindow trong user32.dll 64bit.
Sau khi CreateWindow thành công và swich mode từ 64 về lại 32, WOW64 DLLs sẽ làm nhiệm vụ map internal handle 64bit này sang 1 handle 32bit và return về cho app 32bit.
Còn nhiều, phức tạp lắm, nên em có post cho em gái Ngọc Huyền cái link về WOW64 đó, bà con rãnh thì đọc, hơi nổ đầu nếu chưa có kn, kiến thức về System Coding trong Windows.
Em thì bị gặp mấy vấn đề porting này nhiều rồi, từ thời DOS, qua Win16, rồi Win32. Giờ thì port tiếp qua Win64. Không biết mai mốt còn sống tới Win128 bit hay không, hehe :')

NguyenNgocThuHien · 28/12/17

Win 64 tạo handle 64bits thì em nghe và đọc nhiều rồi, và cũng tin phần nào. Nhưng có một điều làm mâu thuẫn nên em hỏi cho rõ hơn thôi.

Một mặt khẳng định là handle là 64bit.
Một mắt khác là khi khai báo api ta dùng longptr. Mà longptr sẽ là 32bits với excel32 bít chạy trên win64. Vậy khác nào lại khẳng định là handle là 32bit.

Nghe cách giải thích về cái wow64 không hiểu hết nghĩa, nhưng phần nào cũng thấy hợp lý cho 2 điều mâu thuẫn ở trên.

Cũng có thể, em đoán thôi. bin gết chế ra win64 , theo lya thuyết là handle sez có giải giá trị vượt long. Nhưng ông ta vẫn khống chế handle trong khoảng long, để có thể tương thích với các phần mềm cũ. bao giờ 2007, 2003 chết thật sự, hay đến khi không còn excel32bit nữa thì handle mới chính thức vượt ra khỏi long.

ThangCuAnh · 28/12/17

Tội Bill quá, mấy cái này kêu Excel Team, Office Team ra chứ, Bill có còn code ciếc, quản lý gì nữa đâu

NguyenNgocThuHien · 28/12/17

Em không rõ chủ mưu là ai, nên kêu người to đàU nhất ra.

Nguyễn Duy Tuân · 28/12/17

NguyenNgocThuHien đã viết:
Win 64 tạo handle 64bits thì em nghe và đọc nhiều rồi, và cũng tin phần nào. Nhưng có một điều làm mâu thuẫn nên em hỏi cho rõ hơn thôi.

Một mặt khẳng định là handle là 64bit.
Một mắt khác là khi khai báo api ta dùng longptr. Mà longptr sẽ là 32bits với excel32 bít chạy trên win64. Vậy khác nào lại khẳng định là handle là 32bit.

Nghe cách giải thích về cái wow64 không hiểu hết nghĩa, nhưng phần nào cũng thấy hợp lý cho 2 điều mâu thuẫn ở trên.

Cũng có thể, em đoán thôi. bin gết chế ra win64 , theo lya thuyết là handle sez có giải giá trị vượt long. Nhưng ông ta vẫn khống chế handle trong khoảng long, để có thể tương thích với các phần mềm cũ. bao giờ 2007, 2003 chết thật sự, hay đến khi không còn excel32bit nữa thì handle mới chính thức vượt ra khỏi long.

Chính xác là Application 32-bit thì gọi các DLL, OCX 32-bit nên cùng một kiểu giá trị nhé.

mykoloda · 29/12/17

batman1 đã viết:

Thì dùng phiên bản W (phục vụ unicobe) thay cho phien bản A thôi. Tức dùng MessageBoxTimeoutW
Cho code sau vào 1 Modele riêng, vd. Module3

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As String, ByVal lpCaption As String, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrConv(message, vbUnicode), StrConv(Title, vbUnicode), flags, 0, timeout)
End Function

hoặc

Mã:

#If VBA7 Then
    Public Declare PtrSafe Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#Else
    Public Declare Function MessageBoxTimeoutW Lib "user32" (ByVal hWnd As Long, _
                                                        ByVal lpText As Long, ByVal lpCaption As Long, _
                                                        ByVal uType As Long, ByVal wLanguageId As Integer, _
                                                        ByVal dwMilliseconds As Long) As Long
#End If

Function MsgBoxTimeout(ByVal message As String, ByVal timeout As Long, Optional ByVal Title As String = "Message", Optional ByVal flags As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)
End Function

Code trong UserForm1 (xóa khai báo các hàm API đang có)

Mã:

Private Sub CommandButton1_Click()
    MsgBoxTimeout "Ch" & ChrW(7841) & "y th" & ChrW(7917) & Chr(10) & _
                    "N" & ChrW(7871) & "u " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & _
                    ChrW(7869) & " t" & ChrW(7921) & " t" & ChrW(7855) & "t", _
                    4000, "Thông báo", vbInformation
End Sub

Có cách nào phải chờ hoặc nhấn thoát "MsgBoxTimeout" mới sử dụng được bên ngoài trang tính ,form như "MsgBox" thông thường hay dùng không bác?

ThangCuAnh · 29/12/17

Cái flags truyền vào Or thêm cho nó vbSystemModal (0x1000, tương đượng MB_SYSTEMMODAL) hoặc 0x2000 = MB_TASKMODAL (không có hằng VB(A) tương ứng)

batman1 · 29/12/17

mykoloda đã viết:
Có cách nào phải chờ hoặc nhấn thoát "MsgBoxTimeout" mới sử dụng được bên ngoài trang tính ,form như "MsgBox" thông thường hay dùng không bác?

Nếu bạn kích hoạt MsgBoxTimeout từ UserForm1 như trong tập tin ví dụ thì đương nhiên bạn không thể làm được gì trên trang tính, y như dùng MsgBox.

Nếu bạn kích hoạt MsgBoxTimeout từ 1 code khác vd. từ Button1 đặt trên trang tính thì sửa và thêm vbSystemModal cũng vô ích. Vì nó không có tác dụng. Tại sao? Vì MB_APPLMODAL hay MB_SYSTEMMODAL chỉ có tác dụng khi bạn truyền handle vào thông số đầu tiên hWnd. Hiện nay ta đang truyền 0.

Vậy đơn giản chỉ thay thông số đầu. Vd. thay

Mã:

MsgBoxTimeout = MessageBoxTimeOutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)

thành

Mã:

MsgBoxTimeout = MessageBoxTimeOutW(Application.hWnd, StrPtr(message), StrPtr(Title), flags, 0, timeout)

Một khi đã có Application.hWnd thay cho 0 thì chả cần thêm gì cả. Vì lúc đó thì MB_APPLMODAL (vbApplicationModal) là mặc định.

mykoloda · 29/12/17

batman1 đã viết:
Nếu bạn kích hoạt MsgBoxTimeout từ UserForm1 như trong tập tin ví dụ thì đương nhiên bạn không thể làm được gì trên trang tính, y như dùng MsgBox.

Nếu bạn kích hoạt MsgBoxTimeout từ 1 code khác vd. từ Button1 đặt trên trang tính thì sửa và thêm vbSystemModal cũng vô ích. Vì nó không có tác dụng. Tại sao? Vì MB_APPLMODAL hay MB_SYSTEMMODAL chỉ có tác dụng khi bạn truyền handle vào thông số đầu tiên hWnd. Hiện nay ta đang truyền 0.

Vậy đơn giản chỉ thay thông số đầu. Vd. thay

Mã:

MsgBoxTimeout = MessageBoxTimeOutW(0, StrPtr(message), StrPtr(Title), flags, 0, timeout)

thành

Mã:

MsgBoxTimeout = MessageBoxTimeOutW(Application.hWnd, StrPtr(message), StrPtr(Title), flags, 0, timeout)

Một khi đã có Application.hWnd thay cho 0 thì chả cần thêm gì cả. Vì lúc đó thì MB_APPLMODAL (vbApplicationModal) là mặc định.

Trong trang tính đã được rùi bác, còn trên form khi hiện thông báo mình click vào form thì thông báo lại ẩn vẫn sử dụng được form khi chưa tắt thông báo! Có cách nào khi thông báo bắt buộc phải tắt đi mới sử dụng được form không bác?

ThangCuAnh · 29/12/17

Hì hì, thì cậu cứ thử với 1 trong 2 cái value vbSystemModal hay H2000& đi

UserForm1.Show thì show UserForm1 với style modal (vbModal), chứ show modeless thì vẫn rờ chạm em Excel thỏa mái, hì hì

batman1 · 29/12/17

mykoloda đã viết:
Trong trang tính đã được rùi bác, còn trên form khi hiện thông báo mình click vào form thì thông báo lại ẩn vẫn sử dụng được form khi chưa tắt thông báo! Có cách nào khi thông báo bắt buộc phải tắt đi mới sử dụng được form không bác?

Thôi, làm khác
1. Trong Module trước #If VBA7 Then thì thêm

Mã:

Private Const MB_TASKMODAL = &H2000

2. Sửa thành

Mã:

MsgBoxTimeout = MessageBoxTimeOutW(0, StrPtr(message), StrPtr(Title), flags Or MB_TASKMODAL, 0, timeout)

Tức không dùng Application.hWnd nữa mà thêm MB_TASKMODAL vào flags

batman1 · 29/12/17

ThangCuAnh đã viết:
Hì hì, thì cậu cứ thử với 1 trong 2 cái value vbSystemModal hay H2000& đi
UserForm1.Show thì show UserForm1 với style modal (vbModal), chứ show modeless thì vẫn rờ chạm em Excel thỏa mái, hì hì

Nếu bạn viết: 0x2000 = MB_TASKMODAL thì không nói làm gì.
Nhưng bạn viết

Cái flags truyền vào Or thêm cho nó vbSystemModal (0x1000, tương đượng MB_SYSTEMMODAL) hoặc 0x2000 = MB_TASKMODAL

Mà vbSystemModal không có tác dụng nếu thông số đầu vẫn là 0.

ThangCuAnh · 29/12/17

Thì tôi đã nói cậu gì đó thử mà, có chết thằng Tây nào đâu mà đi bắt bẽ ha

À, mà còn 1 đống flags của MessageBoxXXXX nữa, ưn đồ cú mèn, tối về em lục lại post lên cho. Sẵng RE xem cái ông MsgBox của Vờ Bờ Ờ này làm cái gì internal

mykoloda · 29/12/17

batman1 đã viết:
Thôi, làm khác
1. Trong Module trước #If VBA7 Then thì thêm

Mã:

Private Const MB_TASKMODAL = &H2000

2. Sửa thành

Mã:

MsgBoxTimeout = MessageBoxTimeOutW(0, StrPtr(message), StrPtr(Title), flags Or MB_TASKMODAL, 0, timeout)

Tức không dùng Application.hWnd nữa mà thêm MB_TASKMODAL vào flags

Được rồi cám ơn bác nha.

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

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

Huyền thoại GPE

File đính kèm

Thành viên gạo cội

Huyền thoại GPE

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

Thành viên mới

File đính kèm

Thành viên mới

Thành viên đã dừng hoạt động

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Mới rờ Ét xeo

Cute Black Cat

Mới rờ Ét xeo

Thành viên gạo cội

Thành viên gạo cội

Mới rờ Ét xeo

Thành viên gạo cội

Mới rờ Ét xeo

I don't program, I beat code into submission!!!

Mới rờ Ét xeo

I don't program, I beat code into submission!!!

Thành viên gạo cội

Cute Black Cat

Mới rờ Ét xeo

Cute Black Cat

Mới rờ Ét xeo

Cute Black Cat

Mới rờ Ét xeo

Cute Black Cat

File đính kèm

Cute Black Cat

File đính kèm

Mới rờ Ét xeo

Cute Black Cat

Mới rờ Ét xeo

I don't program, I beat code into submission!!!

Thành viên gạo cội

Đang đi tìm hòn đá

I don't program, I beat code into submission!!!

Mới rờ Ét xeo

Nghị Hách

Mới rờ Ét xeo

Cute Black Cat

Mới rờ Ét xeo

Cute Black Cat

Nghị Hách

Thành viên chính thức

Mới rờ Ét xeo