bip sesi ekleme

[Gold_Savt]

Label3 içinde 20 den aşağı gerileyen sayım var.

Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then
Dim i As Long
For i = 20 To 0 Step -1
    Label3.Caption = i
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
Else
'ikinci tıklamada geri sayımı durdur. Bir daha basılırsa kaldığı yerden devam etmeli.
End If
Next i

Bu kodlara son beş saniye bip sesi eklemek istediğimde aşağıdaki kod işe yaramıyor.

If Label3.Text.Value < 6 Then Beep

Toparlayacak olursam yukarda kullandığım kod için
a) ToggleButton ile de geri sayımı durdurup başlatmak istiyorum.
b)Son beş saniyesinde "bip" sesi
c) Sıfıra erdiğinde "bilgisayardan farklı bir uyarı sesi"
Yardımı dokunan üstadlara şimdiden teşekkür ederim.

 

[Muzaffer Ali]

Merhaba

Private Sub ToggleButton1_Click()
    Dim i As Long
    For i = 20 To 0 Step -1
        If ToggleButton1.Value = True Then
            Label3.Caption = i
            DoEvents
            If i < 6 Then Beep
            Application.Wait Now + TimeValue("00:00:01")
        Else
            Exit Sub
        End If
    Next i
End Sub

0 olunca farklı bir ses çalmak için mp3 çalma kodları ekleyebilirsiniz. Forumda var.

 

[Gold_Savt]

Muzaffer Ali Bey, Teşekkür ediyorum.
Yardımlarınız sayesinde aşağıdaki ilaveyi yaparak son beş saniye olayı ve son saniye olayı gerçekleşti.
Sadece süreyi durdurduğumda, sürenin kaldığı yerden devam etmesi kaldı.

Private Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub ToggleButton1_Click()
    Dim i As Long
    For i = 20 To 0 Step -1
        If ToggleButton1.Value = True Then
            Label3.Caption = i
            DoEvents
                If Label3 < 6 Then Beep 207.65, 200
                If Label3 = 0 Then Beep 207.65, 200           
            Application.Wait Now + TimeValue("00:00:01")
        Else
            Exit Sub
        End If
    Next i
End Sub

 

[Muzaffer Ali]

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Dim Sayac As Long

Private Sub ToggleButton1_Click()
    Dim i As Long
    If Sayac = 0 Then Sayac = 20
    For i = Sayac To 0 Step -1
        If ToggleButton1.Value = True Then
            Label3.Caption = i
            DoEvents
                If Label3 < 6 Then Beep 207.65, 200
                If Label3 = 0 Then Beep 207.65, 200
            Application.Wait Now + TimeValue("00:00:01")
        Else
            Sayac = i
            Exit Sub
        End If
    Next i
End Sub
'Sayacı durdurmadan formu kapatırsanız sayaç devam eder. Formu kapatınca sayacı durdurmak için aşağıdaki kodu da ekledim.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ToggleButton1.Value = False
End Sub

 

[Gold_Savt]

Teşekkür ediyorum. Userform sorunsuz çalışıyor.
Düzeltme: Bir sorun var, yeni farkettim. Eğer bir yerde durdurursak örneğin 6.saniyede. Bir sonraki başlangıçlar hep 6.saniyeden oluyor.
Sayaç başa dönmüyor.

 

[Muzaffer Ali]

Yeni Bir buton ekleyip sayacı sıfırlayabilirsiniz.
Butonla aşağıdaki kodu çalıştırmalısınız.

Sayac = 20

 

[Gold_Savt]

Anladım. Teşekkür çok çok teşekkür ederim

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.