Excell'e Geri Sayım Sayacı ekleme yardım!

[amedyan]

ekte verdiğim kronometredeki gibi "bilgi yarışması" çalışma sayfasının a1 hücersine geri sayım sayıcı eklemek ayıca süreyi gong veya zil sesi başlayıp bitirmek istiyorum. Yardım edebilecek arkadaş var mı?

 

[halit3]

ekte verdiğim kronometredeki gibi "bilgi yarışması" çalışma sayfasının a1 hücersine geri sayım sayıcı eklemek ayıca süreyi gong veya zil sesi başlayıp bitirmek istiyorum. Yardım edebilecek arkadaş var mı?

Dosyanız şifreli size alternatif bir kod ekliyorum.

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private isPlaying As Boolean
Dim saat1, dakika1, saniye1, saat2, dakika2, son1
Public Sub Ap_002AC_Play()
Dim mp3File As String '
acılacak_dosya = ("C:\Windows\Media\Windows Ringin.wav")
mp3File = Chr$(34) & acılacak_dosya & Chr$(34)
If isPlaying = True Then
Call mciSendString("Stop MM", 0&, 0&, 0&)
Call mciSendString("Close MM", 0&, 0&, 0&)
Call mciSendString("Open " & mp3File & " Alias MM", 0&, 0&, 0&)
Call mciSendString("Play MM", 0&, 0&, 0&)
Else
Call mciSendString("Stop MM", 0&, 0&, 0&)
Call mciSendString("Close MM", 0&, 0&, 0&)
isPlaying = True
End If
End Sub
Public Sub Ap_002AC_Stop()
If isPlaying = False Then Exit Sub
Call mciSendString("Stop MM", 0&, 0&, 0&)
Call mciSendString("Close MM", 0&, 0&, 0&)
End Sub
Private Sub CommandButton1_Click()
Timer1.Enabled = True
son1 = Format(60 - Val(Mid(ComboBox1, 7, 2)), "00")
End Sub
Private Sub CommandButton2_Click()
Timer1.Enabled = False
Timer2.Enabled = False
Ap_002AC_Stop
End Sub
Private Sub CommandButton3_Click()
Label1.Caption = "00:00:00"
Label2.Caption = "00:00:00"
UserForm_Initialize
End Sub
Private Sub CommandButton4_Click()
Ap_002AC_Play
Ap_002AC_Play
End Sub

Private Sub Timer2_Timer()
Dim basla
Dim bekle
basla = Timer
bekle = 1
While Timer < basla + bekle
DoEvents '1 saniye bekle
Wend
Ap_002AC_Play
End Sub
Private Sub UserForm_Initialize()
Timer1.Enabled = False
Timer1.Interval = 1000
saniye1 = 0
saat1 = 0
dakika1 = 0
saat2 = 0
dakika2 = 0
son1 = 0
On Error Resume Next
For j = 0 To 2
For i = 0 To 59
For r = 0 To 59
ComboBox1.AddItem Format(j, "00") & ":" & Format(i, "00") & ":" & Format(r, "00")
Next
Next
Next
ComboBox1.Text = "00:00:00"
End Sub

Private Sub Timer1_Timer()
saniye1 = saniye1 + 1
If saniye1 = 60 Then
saniye1 = 0
dakika1 = dakika1 + 1
If dakika1 = 60 Then
dakika1 = 0
saat1 = saat1 + 1
If saat1 = 24 Then
saat1 = 0
End If
End If
End If
If dakika1 = "" Then
dakika1 = "00"
End If
If saat1 = "" Then
saat1 = "00"
End If
Label2.Caption = Format(saat1, "00") & ":" & Format(dakika1, "00") & ":" & Format(saniye1, "00")
saat2 = Val(Mid(ComboBox1.Text, 1, 2))
If Val(Mid(ComboBox1.Text, 4, 2)) - 1 < 0 Then
dakika2 = 0
Else
dakika2 = Val(Mid(ComboBox1.Text, 4, 2)) - 1
End If
Label1.Caption = Format(saat2 - saat1, "00") & ":" & Format(dakika2 - dakika1, "00") & ":" & Format((60 - saniye1 - son1), "00")
On Error Resume Next
If Val(Mid(Label1, 1, 2)) = 0 Then
If Val(Mid(Label1, 4, 2)) = 0 Then
If Val(Mid(Label1, 7, 2)) = 10 Then Beep
If Val(Mid(Label1, 7, 2)) = 9 Then Beep
If Val(Mid(Label1, 7, 2)) = 8 Then Beep
If Val(Mid(Label1, 7, 2)) = 7 Then Beep
If Val(Mid(Label1, 7, 2)) = 6 Then Beep
If Val(Mid(Label1, 7, 2)) = 5 Then Beep
If Val(Mid(Label1, 7, 2)) = 4 Then Beep
If Val(Mid(Label1, 7, 2)) = 3 Then Beep
If Val(Mid(Label1, 7, 2)) = 2 Then Beep
If Val(Mid(Label1, 7, 2)) = 1 Then Beep
End If
End If
If Label2.Caption = ComboBox1.Text Then
Timer2.Enabled = True
Timer2.Interval = 1000
Ap_002AC_Play
Ap_002AC_Play
 
Label1.Caption = "00:00:00"
Timer1.Enabled = False
End If
End Sub

 

[amedyan]

ilginiz için teşekkürler

eklediğim resimde gibi iki yerde hata veriyor dosyayı çalıştıramadım tekrar bakabilirmisiniz

 

[halit3]

eklediğim resimde gibi iki yerde hata veriyor dosyayı çalıştıramadım tekrar bakabilirmisiniz

Timer nesnesi olmadığından oluyor aşağıdaki linke bir bakınız.

http://www.excel.web.tr/f167/timer-nesnesinin-kurulumu-t78713.html