Mesaj box'a 5 saniye içerisinde cevap verilmez ise YES kabul et

[parcequil]

Arkadaşlar merhaba,
VBA da Mesaj box kutusunda yes no seçeneğine 5 saniye içerisinde cevap verilmez ise yes kabul etsin, kodunu nasıl yazabiliriz.

Teşekkürler

 

[muhasebeciyiz]

Public Function YesNoMsgBox(strPrompt As String, Optional strTitle As String = "Uyarı") As Boolean

Dim lngTimeout As Long
Dim lngAnswer As Long

lngTimeout = Timer + 5
MsgBox strPrompt, vbYesNo + vbQuestion, strTitle

Do While Timer < lngTimeout
Select Case MsgBox("5 saniye içinde cevap vermezseniz 'Evet' kabul edilecektir.", vbOKOnly + vbExclamation, "Zaman Aşı!")
Case vbOK
Exit Do
End Select
Loop

If Timer >= lngTimeout Then
YesNoMsgBox = True
Else
YesNoMsgBox = (lngAnswer = vbYes)
End If

End Function

 

[parcequil]

Public Function YesNoMsgBox(strPrompt As String, Optional strTitle As String = "Uyarı") As Boolean

Dim lngTimeout As Long
Dim lngAnswer As Long

lngTimeout = Timer + 5
MsgBox strPrompt, vbYesNo + vbQuestion, strTitle

Do While Timer < lngTimeout
Select Case MsgBox("5 saniye içinde cevap vermezseniz 'Evet' kabul edilecektir.", vbOKOnly + vbExclamation, "Zaman Aşı!")
Case vbOK
Exit Do
End Select
Loop

If Timer >= lngTimeout Then
YesNoMsgBox = True
Else
YesNoMsgBox = (lngAnswer = vbYes)
End If

End Function

Çok teşekkürler