kronometre geri sayım

[panmacer]

iyi günler arkadaşlar 20 den geriye doğru sayan bir kronometreye ihtiyacım var bu arada saniye sesi ve süre bitince ding dong diye ses çıkarmak istiyorum bunu nasıl yapabilirim teşekkürler...

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, standart bir modül sayfasına kopyalayınız.

"Basla" makrosunu çalıştırınız ve sonucu görünüz. "Dingdong" yerine "Tada" olur mu ?

Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
                "sndPlaySoundA" (ByVal lpszSoundName As String, _
                 ByVal uFlags As Long) As Long
Dim x As Integer
Dim sure As Integer
[COLOR=green]'-------------------[/COLOR]
Sub Basla()
sure = 20 - x
Application.OnTime Now + TimeSerial(0, 0, 1), "Hesapla"
End Sub
[COLOR=green]'----------------[/COLOR]
Sub Hesapla()
If sure = 0 Then
   Call sndPlaySound32("c:\windows\media\tada.WAV", 0)
   End
Else
  x = x + 1
  Call Basla
  Cells(1, 1) = sure
  Beep
End If
End Sub

 

[Tasarım]

Aşağıdaki kodları, standart bir modül sayfasına kopyalayınız.

"Basla" makrosunu çalıştırınız ve sonucu görünüz. "Dingdong" yerine "Tada" olur mu ?

Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
                "sndPlaySoundA" (ByVal lpszSoundName As String, _
                 ByVal uFlags As Long) As Long
Dim x As Integer
Dim sure As Integer
[COLOR=green]'-------------------[/COLOR]
Sub Basla()
sure = 20 - x
Application.OnTime Now + TimeSerial(0, 0, 1), "Hesapla"
End Sub
[COLOR=green]'----------------[/COLOR]
Sub Hesapla()
If sure = 0 Then
   Call sndPlaySound32("c:\windows\media\tada.WAV", 0)
   End
Else
  x = x + 1
  Call Basla
  Cells(1, 1) = sure
  Beep
End If
End Sub

Arkadaşlar bu kod oldukça işime yaradı ancak bir sorun var ve ben bir türlü aşamadım. Sayaç geriye doğru sayıp, işlemi bitirince formu kapatıyor, bende formun kapanmasını istemiyorum, bunu nasıl engelleyebilirim?
Lütfen acil yardım edebilirseniz, çok memnun olacağım.

 

[Zeki Gürsoy]

Merhaba,

Sub Hesapla()
If sure = 0 Then
   Call sndPlaySound32("c:\windows\media\tada.WAV", 0)
   [COLOR=Blue][B]End[/B][/COLOR]
Else
  x = x + 1
  Call Basla
  Cells(1, 1) = sure
  Beep
End If
End Sub

Koyu mavi satırı silin..

 

[Tasarım]

Merhaba,

Sub Hesapla()
If sure = 0 Then
   Call sndPlaySound32("c:\windows\media\tada.WAV", 0)
   [COLOR=Blue][B]End[/B][/COLOR]
Else
  x = x + 1
  Call Basla
  Cells(1, 1) = sure
  Beep
End If
End Sub

Koyu mavi satırı silin..

Ok. İşlem tamamdır, allah razı olsun.

 

[baydeniro]

Çok teşekkürler, güzel konu, süper cevaplar. Herkese teşekkür

 

[SWORD]

gerçekten çok harika. birde herhangi bir tuşa tıklanınca kronometreyi durdurabilecek bir kod var mı acaba?

 

[nane]

Aşağıdaki kodları, standart bir modül sayfasına kopyalayınız.

"Basla" makrosunu çalıştırınız ve sonucu görünüz. "Dingdong" yerine "Tada" olur mu ?

Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
                "sndPlaySoundA" (ByVal lpszSoundName As String, _
                 ByVal uFlags As Long) As Long
Dim x As Integer
Dim sure As Integer
[COLOR=green]'-------------------[/COLOR]
Sub Basla()
sure = 20 - x
Application.OnTime Now + TimeSerial(0, 0, 1), "Hesapla"
End Sub
[COLOR=green]'----------------[/COLOR]
Sub Hesapla()
If sure = 0 Then
   Call sndPlaySound32("c:\windows\media\tada.WAV", 0)
   End
Else
  x = x + 1
  Call Basla
  Cells(1, 1) = sure
  Beep
End If
End Sub

Merhabalar;
Gerçekten çok güzel, yalnız süreyi değişken yapabilmek için sayfada AA2 hücresine girilen değere göre yapabilirmiyiz.
Koddan süre değiştirmek yerine AA2 hücresi örnek: 45 saniye veya diğer bir soru için 60 sn yapmak istiyorum.
Yardımlarınız için şimdiden teşekkürler
Yb®

 

[YUSUF44]

Sanıyorum sure = 20 - x bölümünü sure = [AA2] - x olarak değiştirirseniz olacaktır. Deneyip dönerseniz sevinirim.

 

[YUSUF44]

Az önce denedim, belirttiğim gibi yaptığınızda AA2'de yazan sayıdan geriye sayıyor:

Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
                "sndPlaySoundA" (ByVal lpszSoundName As String, _
                 ByVal uFlags As Long) As Long
Dim x As Integer
Dim sure As Integer
'-------------------
Sub Basla()
sure = [aa2] - x
Application.OnTime Now + TimeSerial(0, 0, 1), "Hesapla"
End Sub
'----------------
Sub Hesapla()
If sure = 0 Then
   Call sndPlaySound32("c:\windows\media\tada.WAV", 0)
   End
Else
  x = x + 1
  Call Basla
  Cells(1, 1) = sure
  Beep
End If
End Sub

 

[nane]

Sanıyorum sure = 20 - x bölümünü sure = [AA2] - x olarak değiştirirseniz olacaktır. Deneyip dönerseniz sevinirim.

Evet oldu.
tşk.Yb®

 

[Muzaffer Ali]

Konuyu 3 kişi cevaplamaya çalışmış onlarca kişi faydalanmış ama soruyu soranın cevaplarla ilgilendiği yok.:roll:

 

[YUSUF44]

Konuyu 3 kişi cevaplamaya çalışmış onlarca kişi faydalanmış ama soruyu soranın cevaplarla ilgilendiği yok.:roll:

hakikaten öyle olmuş Sayesinde ben de yeni bir şey öğrendim bu arada

 

[NBATMAN]

Merhaba Ekte VBASicde yaptığım bir kronometre var.