2 saniye görünen mesaj

[ASLAN7410]

Merhaba arkadaşlar, herkese hayırlı seneler.

Aşağıdaki mesajın 2 saniye görünüp kapanmasını istiyorum, aşağıdaki kodun arasına kırmızı ile olan kod ekledim ama kodu çalıştıramadım.

Forumda araştırdım bulduklarımı kendi sayfama uyarlayamadım.

Private Sub Worksheet_Activate()
    MsgBox ("Bilgiler yenilendi ! . ."), vbInformation, "A S L A N"
    [COLOR="Red"]Application.Wait (Now + TimeValue("0:00:02"))[/COLOR]
End Sub

Aşağıdaki gibi bir kod daha buldum bu kod 4 saniye sürüyor, saniyeyi düşürmek için bu kodda nereyi değiştirmem gerekir.

CreateObject("WScript.Shell").Popup "Bilgiler yenilendi ! . .", 3, "UYARI"

Yardım edecek arkadaşlara teşekkür ederim.

 

[YUSUF44]

ikinci kodda 3 olduğunda 4 saniye ise 1 yaptığınızda 2 saniye olur diye tahmin ediyorum. Denedim , oldu.

 

[ASLAN7410]

Sayın Yusuf Bey ilginiz için teşekkür ediyorum.

Sadece olabilir mi diye soruyorum, aşağıdaki kodu nasıl çalıştırabilirim?

Private Sub Worksheet_Activate()
    MsgBox ("Bilgiler yenilendi ! . ."), vbInformation, "A S L A N"
    Application.Wait (Now + TimeValue("0:00:02"))
End Sub

 

[YUSUF44]

Nasıl çalışır bilmiyorum maalesef. O kodun Wait kısmı kodun 2 saniye hiçbir şey yapmamasını sağlıyor. Sonra emsaj kutusunun ekrandan kaybolması için Ok tuşuna basılması gerekiyor, bu basma işlemi kodla olur mu bilmiyorum.

 

[YUSUF44]

Aşağıda çeşitli yöntemler verilmiş ama normal msgbox ile yapılan yok maalesef. Ya popup, ya userform kullanmak gerekiyor:

http://www.tushar-mehta.com/publish...display_message_for_a_specific_duration.shtml

 

[ÖmerBey]

Msgbox çıktığı zaman kod çalışmayı durduruyor. Bu yöntemle olacağını sanmıyorum. Ama userform kullanırsanız olur:

UserForm1.Show 0
Application.Wait Now + TimeValue("00:00:02")
Unload UserForm1

 

[ÖmerBey]

Bir de şöyle bir api var ama popup varken buna ne gerek var diye de sormuyor değilim...

'To display a timed Msgbox use the Msgbox2 routine given below. Note, a demonstration routine can be found at the bottom of this post:

'------------API calls for Msgbox------------------------
'------------MUST BE PLACED IN A STANDARD MODULE----------
Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long


'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub


'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub



'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function Msgbox2(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    Msgbox2 = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function

''Demonstration routine
Sub TestMessage()
    Dim lRetVal As VbMsgBoxResult
    lRetVal = Msgbox2("hello .. the program is fully functional." & vbCrLf & _
    "Per la verifica delle vincite andare indietro col cursore ogni 5° del mese.", vbOKOnly + vbInformation, "AVVISO!!!", 6000)
    Debug.Print lRetVal
End Sub

 

[ASLAN7410]

Sayın Yusuf Bey ve Sayın Mucit ilginiz için çok teşekkür ediyorum.

Burada en kolay ve en basit kullanım sanırım bu şekilde.

Private Sub Worksheet_Activate()
          CreateObject("WScript.Shell").Popup "Bilgiler yenilendi ! . .", 1, "UYARI"
End Sub