對話框如何出現在最前面

lolmuta

我用ontime，每固定時間就會彈出對話框來提示使用者。
使用者可能在看網頁,聊msn…
我需要對話框可以蓋在所有軟體的最前面，好提示使用者。
msgbox並沒有辦法作到。

我測試用的程式

1. '在sheet1設二個按鈕，一個開啟計時器一個關閉
   
2. Private Sub CommandButton1_Click()
   
3. Call ssOff
   
4. End Sub
   
5. Private Sub CommandButton2_Click()
   
6. Call ssOn
   
7. End Sub
   

复制代码

1. '在module1中
   
2. Public tm As Date
   
3. Sub ssOn()
   
4. tm = Now + TimeValue("0:0:5")
   
5. Application.OnTime tm, "ssOn"
   
6. '出現對話框
   
7. Call MsgBoxForGround
   
8. End Sub
   
9. Sub ssOff()
   
10. Application.OnTime tm, "ssOn", , False
    
11. End Sub
    
12. Sub MsgBoxForGround()
    
13. '請幫我寫能夠置頂的對話框
    
14. MsgBox "test", vbSystemModal
    
15. End Sub
    

复制代码

其附件如下

[ 本帖最后由 lolmuta 于 2010-11-10 08:40 编辑 ]

lolmuta

沒人可以幫忙嗎?

lolmuta

實在讓人失望，所以我只好求助google，找半天，只找到有人說
PInvoke:SetWindowPos
Private Const HWND_TOPMOST = -1
就這樣
找setwindowpos只說了是api，然後一堆用法，
找範例，只有c++ vb.net
最後用了vba setwindowpos 前面也一堆沒用的，後來才出現…
最後emily果然沒讓我失望
二大EXCEL範例網
http://cat14051.mysinablog.com/index.php這是EMILY
http://chijanzen.net/wp/

1. '在sheet1設二個按鈕，一個開啟計時器一個關閉
   
2. Private Sub CommandButton1_Click()
   
3. Call ssOff
   
4. End Sub
   
5. Private Sub CommandButton2_Click()
   
6. Call ssOn
   
7. End Sub

复制代码

1. 
   
2. 'MODULE1
   
3. Public tm As Date
   
4. 
   
5. Sub ssOn()
   
6. tm = Now + TimeValue("0:0:5")
   
7. Application.OnTime tm, "ssOn"
   
8. 
   
9. '出現對話框
   
10. 
    
11. Call MsgBoxForGround
    
12. End Sub
    
13. Sub ssOff()
    
14. 'Application.OnTime EarliestTime:=tm, Procedure:="ssOn", Schedule:=False
    
15. Debug.Print "Will End " & tm & " Ontime"
    
16. Application.OnTime tm, "ssOn", , False
    
17. End Sub
    
18. 
    
19. Sub MsgBoxForGround()
    
20. '就是這個讓功能實現!!!!
    
21. Call MakeTopMost(Application.hwnd)
    
22. MsgBox "test", vbSystemModal
    
23. End Sub
    

复制代码

1. '---------------------------------------------------------------------------------------
   
2. ' Module    : Module2
   
3. ' DateTime  :
   
4. ' Author    :
   
5. ' Purpose   :
   
6. '---------------------------------------------------------------------------------------
   
7. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   
8. Private Const HWND_TOPMOST = -1
   
9. Private Const HWND_NOTOPMOST = -2
   
10. Private Const SWP_NOMOVE = &H2
    
11. Private Const SWP_NOSIZE = &H1
    
12. Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE
    
13. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
14.     Call MakeNormal(Application.hwnd)
    
15. End Sub
    
16. Public Sub MakeNormal(hwnd As Long)
    
17.     SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    
18. End Sub
    
19. 
    
20. Public Sub MakeTopMost(hwnd As Long)
    
21.     SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    
22. End Sub
    
23. 
    
24. 
    
25. Sub Test()
    
26.     Call MakeTopMost(Application.hwnd)
    
27.     ' Call MakeNormal(Application.hwnd)
    
28. End Sub
    

复制代码

為何API總是那麼難學?!

[ 本帖最后由 lolmuta 于 2010-11-10 08:38 编辑 ]