الأخوة الأعزاء
كل عام و أنتم بخير و تقبل الله منكم صيامكم و قيامكم ، و أعاد عليكم المناسبة بكل خير و عافية ..
لدي سؤال عن طريقة عمل :
حقل به الوقت الحالي (حسب ساعة الجهاز)
و في أسفله حقل يبين الثواني فقط
و حقل ثاني به الدقائق فقط
و حقل ثالث به الساعة فقط و كل ذلك حسب ساعة الجهاز..
و حقل لحساب وقت البداية.
و حقل أخير لحساب وقت النهاية.
المطلوب عمله هو ساعة توقف (STOP WATSH) بحث يتم تحديد عدد الدقائق المطلوبة و يقوم الحقل بالعد التنازلي و ما إن تنتهي المدة المحددة يقوم بإنذار ما كتشغيل ملف صوتي ..
== المراد استخدام البرنامج في مركز لتأهيل المعوقين لحساب وقت الإجابة عن أسئلة ذكاء لمعرفة مستويات الذكاء عند المنتسبين و أيضا تمارين ميدانية لنفس الغرض ==
أعلم أن الأمر يحتاج لكود خاص لعمل العد التنازلي و لذا ألتمس منكم المساعدة ..
وجدت هذا الكود و لكني لم استطع التعامل معه و بالأحرى لم أفهمه و لم يعمل معي ، و أضعه هنا للفائدة ..
_____________________________
' --------------------------------------------------------------------------------
' Copyright ©1999-2000, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Tmr()
'Just in the eventuality that you click the start button twice
'isRunning stores the current state of the macro
'TRUE = Running; FALSE = Idle
Static isRunning As Boolean
If isRunning = True Then
End
Else
isRunning = True
Dim TMinus As Integer
Dim xtime As Date
xtime = Now
'On Slide 1, Shape 1 is the textbox
With ActivePresentation.Slides(1)
.Shapes(2).TextFrame.TextRange.Text = "Ladies & Gentlemen." & vbCrLf & _
"Please be seated. We are about to begin."
With .Shapes(1)
'Countdown in seconds
TMinus = 120
Do While (TMinus > -1)
' Suspend program execution for 1 second (1000 milliseconds)
Sleep 1000
xtime = Now
.TextFrame.TextRange.Text = Format(TimeValue(Format(Now, "hh:mm:ss")) - _ TimeSerial(Hour(Now), Minute(Now), Second(Now) + TMinus), "hh:mm:ss")
TMinus = TMinus - 1
' Very crucial else the display won't refresh itself
DoEvents
Loop
End With
' 3-2-1-0 Blast off and move to the next slide or any slide for that matter
SlideShowWindows(1).View.GotoSlide (2)
isRunning = False
.Shapes(2).TextFrame.TextRange.Text = "Click here to start countdown"
End
End With
End If
End Sub
_____________________________
و تحياتي للجميع