طلب كود لعداد تنازلي في هذه الخلية

[ابوحبيبه]

السلام عليكم

هل يمكن وضع عداد تنازلي في هذه الخلية لوقت مدته 5 ثوان عن طريق كود 🎯

وبعد انتهاء الوقت يظهر الجواب . على ان يبدا  العداد من جديد مع بداية كل سؤال 🕓

 

 

test_k.xlsx

تم تعديل يونيو 23, 2023 بواسطه ابوحبيبه

[ابوحبيبه]

اذا كانت الخلية السابقة غير منطقية يمكن استخدام الخلية الجديدة هذه...

تم تعديل يونيو 23, 2023 بواسطه ابوحبيبه

[lionheart]

In ThisWorkbook Module

Private Sub Workbook_Open()
    Application.OnKey "{F9}", "TestMacro"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{F9}"
End Sub

 

In Standard Module

Sub TestMacro()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Qution")
    ws.Range("G17").Value = Empty: ws.Range("D17").Value = Empty
    With ws.Range("D17")
        .Formula = "=RANDBETWEEN(data1!A1,data1!A30)"
        .Value = .Value
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = False
        .Calculation = xlCalculationManual
            .Wait Now + TimeValue("00:00:05")
            ws.Range("G17").Formula = "=LOOKUP(D17,data1!A1:A730,data1!F1:F30)"
            .Calculate
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

 

[ابوحبيبه]

جزاك الله خيرا ... 

                    على هذا المجهود