اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

مشكلة فى ساعه ايقاف


UserUser2
إذهب إلى أفضل إجابة Solved by AbuuAhmed,

الردود الموصى بها


عند الوصل للوقت المطلوب تظهر الساعه بالشكل المرفق فى الصورة ولا يصفر 
مرفق الكود المستخدم 

Private Sub Form_Timer()
Dim Hours As String
   Dim Minutes As String
   Dim Seconds As String
   Dim MilliSec As String
   Dim msg As String
   Dim ElapsedMilliSec As Long

   ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + _
      TotalElapsedMilliSec

  

   Hours = Format((ElapsedMilliSec \ 3600000), "00")
   Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00")
   Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00")
   MilliSec = Format((ElapsedMilliSec Mod 1000) \ 10, "00")

   Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" _
      & MilliSec
If Me!ElapsedTime = "00:00:00:00" Then
Me.[test Name].BackColor = RGB(225, 0, 0)

PlaySound Application.CurrentProject.Path & "\sounds\test.WAV"

DoCmd.Restore

TotalElapsedMilliSec = TotalElapsedMilliSec + _
          (GetTickCount() - StartTickCount)

      Me.TimerInterval = 0
   
    TotalElapsedMilliSec = 0
   Me!ElapsedTime = "00:00:00:00"
   Me!btnStartStop.Caption = "start"
   Me.btnReset.Enabled = True
      End If

STOP.JPG

رابط هذا التعليق
شارك

تأكد أن المجلد الذي يحتوي تطبيق/برنامج أكسس يحتوي على مجلد فرعي باسم sounds
تأكد أن ملف الصوت "test.wav" موجود داخل مجلد sounds

إذا لم يعمل استخدم المديول الموجود في المثال المرفق وتخلص من موديول الصوت الذي في تطبيقك.

مشاركتي بناءً على فهمي أن "لا يصفر" بمعنى أنه لا يصدر صوت الصفير 🙂

PlaySoundApp.rar

رابط هذا التعليق
شارك

20 ساعات مضت, AbuuAhmed said:

تأكد أن المجلد الذي يحتوي تطبيق/برنامج أكسس يحتوي على مجلد فرعي باسم sounds
تأكد أن ملف الصوت "test.wav" موجود داخل مجلد sounds

إذا لم يعمل استخدم المديول الموجود في المثال المرفق وتخلص من موديول الصوت الذي في تطبيقك.

مشاركتي بناءً على فهمي أن "لا يصفر" بمعنى أنه لا يصدر صوت الصفير 🙂

PlaySoundApp.rar 605.55 kB · 3 downloads

المشكلة مش فى الصوت 
الساعه بتفضل شغالة مش بتقف بتكمل بالسالب مثل الصورة بالاعلى 

رابط هذا التعليق
شارك

في 20‏/11‏/2022 at 23:46, UserUser2 said:

ولا يصفر

مصطلحك غامض 🙂 عموما أعتقد من الصعوبة أن تلقى من يساعدك بدون مثال، ضع مثالك وجربه قبل أن ترفعه لتتأكد أنك أرفقت كل الدوال والإجراءات المطلوبة.
على كل حال سأحاول آخذ نظرة ثانية على الكود الليلة إن شاء الله وربنا يسهل الأمور.

رابط هذا التعليق
شارك

السلام عليكم 🙂

 

اخي UserUser2 انظر الفرق بين طريقة وضعك الكود:

image.png.8b727e79d15111eda47338e19d7fb771.png

.

بينما اذا استعملت الطريقة الخاصة لتنسيق الكود

image.png.097a198206747e6f478e8517a93b7058.png

.

ووضعت الكود في النافذة المنبثقة:

image.png.d6df7798ff61959660d0da3a8ee373d1.png

.

سيكون الكود بهذا التنسيق الجميل ، والجميع يقدر يقراءه 🙂

Private Sub Form_Timer()
Dim Hours As String
   Dim Minutes As String
   Dim Seconds As String
   Dim MilliSec As String
   Dim msg As String
   Dim ElapsedMilliSec As Long

   ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + _
      TotalElapsedMilliSec

  

   Hours = Format((ElapsedMilliSec \ 3600000), "00")
   Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00")
   Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00")
   MilliSec = Format((ElapsedMilliSec Mod 1000) \ 10, "00")

   Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" _
      & MilliSec
If Me!ElapsedTime = "00:00:00:00" Then
Me.[test Name].BackColor = RGB(225, 0, 0)

PlaySound Application.CurrentProject.Path & "\sounds\test.WAV"

DoCmd.Restore

TotalElapsedMilliSec = TotalElapsedMilliSec + _
          (GetTickCount() - StartTickCount)

      Me.TimerInterval = 0
   
    TotalElapsedMilliSec = 0
   Me!ElapsedTime = "00:00:00:00"
   Me!btnStartStop.Caption = "start"
   Me.btnReset.Enabled = True
      End If

.

جعفر

رابط هذا التعليق
شارك

جرب بدل هذا السطر:
 

If Me!ElapsedTime = "00:00:00:00" Then

بهذا السطر:
 

If ElapsedMilliSec <= 0 Then

ليصبح الكود بهذا الشكل:
 

Private Sub Form_Timer()
    Dim Hours As String
    Dim Minutes As String
    Dim Seconds As String
    Dim MilliSec As String
    Dim msg As String
    Dim ElapsedMilliSec As Long

    ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + TotalElapsedMilliSec

    Hours = Format((ElapsedMilliSec \ 3600000), "00")
    Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00")
    Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00")
    MilliSec = Format((ElapsedMilliSec Mod 1000) \ 10, "00")

    Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" & MilliSec
    'If Me!ElapsedTime = "00:00:00:00" Then
    If ElapsedMilliSec <= 0 Then
        Me.[test Name].BackColor = RGB(225, 0, 0)
        PlaySound Application.CurrentProject.Path & "\sounds\test.WAV"
        DoCmd.Restore
        TotalElapsedMilliSec = TotalElapsedMilliSec + (GetTickCount() - StartTickCount)
        Me.TimerInterval = 0
   
        TotalElapsedMilliSec = 0
        Me!ElapsedTime = "00:00:00:00"
        Me!btnStartStop.Caption = "start"
        Me.btnReset.Enabled = True
    End If
End Sub

 

رابط هذا التعليق
شارك

هل جربت؟ جوابك لا يفيد بذلك وهذا استهتار فينا غير مقبول.

أقترح على المشرفين بغلق موضوعك إذا لم ترفع تطبيقك للتعديل عليه ، أنت تضيع أوقاتنا وحتى ردودك غير موفقة وغير واضحة.

رابط هذا التعليق
شارك

في 23‏/11‏/2022 at 10:11, AbuuAhmed said:

هل جربت؟ جوابك لا يفيد بذلك وهذا استهتار فينا غير مقبول.

أقترح على المشرفين بغلق موضوعك إذا لم ترفع تطبيقك للتعديل عليه ، أنت تضيع أوقاتنا وحتى ردودك غير موفقة وغير واضحة.

شكرا لتعبك 
اكيد جربت 
الجزء اللى حضرتك اشرت اليه كل دوره ان عند وجود 00:00:00 يغير لون الحقل 

رابط هذا التعليق
شارك

في 23‏/11‏/2022 at 17:59, UserUser2 said:

ليس له علاقه 

حياك الله أخي ، في جوابك جزم بأنه ليس له علاقة ، وهذا خطأ منك ، يجب أن ترجع بنتيجة تجربتك الجديدة ، أنا أجزم أن له علاقة وجزمي راجع لخبرتي في الأكواد ، حيث لا يوجد شرط آخر غير الذي أخبرتك عنه ، نعم ربما لا زالت المشاكل لم تنتهي ولكن الأكيد أن المشكلة الجديدة تختف عن المشكلة الأولى.

المشكلة الأولى يفشل في الفحص ويستمر المؤقت يستمر إلى ما لا نهاية.
الآن لن يستمر ولكن .. قد ترى بعد التوقف أن الناتج لا يزال به أرقام سالبة وخصوصا في الميلي ثانية لماذا؟:
لأن المؤقت سيكون أسرع من أن يقف على القيمة صفر بل سيتعادها ثم سيتقف مع الشرط الذي قمت أنا بتعديله، وهذا يحتاج إلى تعديل آخر.

عموما الكود به عدة أخطاء وأستطيع أن أحددها لك، ولكن لما أرى منك استعداد وقابلية لتقبلها، ولكن بجزمك أنت صديتني عن المواصلة والتعاون معك.
إن لم تستطع وضع مثال للتعديل عليه، سوق أقوم بتنقيح الكود، بانتظار إشارة منك، وأنا تحت أمرك.

موفق أخي.
 

رابط هذا التعليق
شارك

لن أنتظر

بعض الملاحظات على الكود:
 

Private Sub Form_Timer()
    Dim Hours As String
    Dim Minutes As String
    Dim Seconds As String
    Dim MilliSec As String
    Dim msg As String
    Dim ElapsedMilliSec As Long

    ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + TotalElapsedMilliSec

    Hours = Format((ElapsedMilliSec \ 3600000), "00")
    Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00")
    Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00")
    MilliSec = Format((ElapsedMilliSec Mod 1000) \ 10, "00")
    'أعلاه لا يعطي الميلي ثانية لأن الثانية 1000 ميلي وليس 100 ربما لو تزيد التنسيق صفرا يكون الناتج صحيحا

    Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" & MilliSec
    
    'If Me!ElapsedTime = "00:00:00:00" Then     'في هذا السطر قد تنتقل القيمة من الموجب إلى السالب دون أن يمر بالصفر
    If ElapsedMilliSec <= 0 Then
        Me.[test Name].BackColor = RGB(225, 0, 0)
        PlaySound Application.CurrentProject.Path & "\sounds\test.WAV"
        DoCmd.Restore   'لا أرى حاجة له
        
        'السطر التالي لا داعي له لأنه بعد هذا السطر يتم تصفيره
        'TotalElapsedMilliSec = TotalElapsedMilliSec + (GetTickCount() - StartTickCount)
        Me.TimerInterval = 0	'يفضل وضعه بعد شرط إف مباشرة حتى لا يكون هناك أي تأخير
   
        TotalElapsedMilliSec = 0    
        Me!ElapsedTime = "00:00:00:00"  'الأكيد لن تحصل على أرقام سالبة بعد هذا السطر
        
        Me!btnStartStop.Caption = "start"
        Me.btnReset.Enabled = True
    End If
End Sub

 

تم تعديل بواسطه AbuuAhmed
رابط هذا التعليق
شارك

جرب هذا الكود بعد التنقيح ولا تنسى أن تقرأ ملاحظاتي في مشاركاتي السابقة.
 

Private Sub Form_Timer()
    Dim Hours As String
    Dim Minutes As String
    Dim Seconds As String
    Dim MilliSec As String
    Dim ElapsedMilliSec As Long

    ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + TotalElapsedMilliSec

    If ElapsedMilliSec > 0 Then
        Hours = Format((ElapsedMilliSec \ 3600000), "00")
        Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00")
        Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00")
        MilliSec = Format((ElapsedMilliSec Mod 1000), "000")

        Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" & MilliSec
    Else
        Me.TimerInterval = 0
        TotalElapsedMilliSec = 0
        Me!ElapsedTime = "00:00:00:00"
        
        Me.[test Name].BackColor = RGB(225, 0, 0)
        PlaySound Application.CurrentProject.Path & "\sounds\test.WAV"
        DoCmd.Restore
        Me!btnStartStop.Caption = "start"
        Me.btnReset.Enabled = True
    End If
End Sub

 

تم تعديل بواسطه AbuuAhmed
  • Like 1
رابط هذا التعليق
شارك

18 دقائق مضت, AbuuAhmed said:

لن أنتظر

بعض الملاحظات على الكود:
 

Private Sub Form_Timer()
    Dim Hours As String
    Dim Minutes As String
    Dim Seconds As String
    Dim MilliSec As String
    Dim msg As String
    Dim ElapsedMilliSec As Long

    ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + TotalElapsedMilliSec

    Hours = Format((ElapsedMilliSec \ 3600000), "00")
    Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00")
    Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00")
    MilliSec = Format((ElapsedMilliSec Mod 1000) \ 10, "00")
    'أعلاه لا يعطي الميلي ثانية لأن الثانية 1000 ميلي وليس 100 ربما لو تزيد التنسيق صفرا يكون الناتج صحيحا

    Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" & MilliSec
    
    'If Me!ElapsedTime = "00:00:00:00" Then     'في هذا السطر قد تنتقل القيمة من الموجب إلى السالب دون أن يمر بالصفر
    If ElapsedMilliSec <= 0 Then
        Me.[test Name].BackColor = RGB(225, 0, 0)
        PlaySound Application.CurrentProject.Path & "\sounds\test.WAV"
        DoCmd.Restore   'لا أرى حاجة له
        
        'السطر التالي لا داعي له لأنه بعد هذا السطر يتم تصفيره
        'TotalElapsedMilliSec = TotalElapsedMilliSec + (GetTickCount() - StartTickCount)
        Me.TimerInterval = 0	'يفضل وضعه بعد شرط إف مباشرة حتى لا يكون هناك أي تأخير
   
        TotalElapsedMilliSec = 0    
        Me!ElapsedTime = "00:00:00:00"  'الأكيد لن تحصل على أرقام سالبة بعد هذا السطر
        
        Me!btnStartStop.Caption = "start"
        Me.btnReset.Enabled = True
    End If
End Sub

 

اشكرك 
بعتذر عن التاخير 
هجرب وارد على حضرتك 

رابط هذا التعليق
شارك

الفلكيون لهم تقسيمات أخرى:

فبعد الدقيقة:
- ثانية وهي جزء من 60 من الدقيقة
- ثالثة وهي جزء من 60 من الثانية

وهكذا لو أراد أحد التوسع يمكنه استخدام رابعة وخامسة أيضا وكلها أجزاء من 60.

فأنت بمثالك لك ثلاث خيارات:
- ميلي أو ميللي ثانية وهي جزء من 1000 من الثانية وهي الأفضل.
- ثالثة وهي جزء من 60 من الثانية.
- كسر من 100 من الثانية أي للقيمة ثانية ونصف تظهر هكذا "01.50" ثانية

 

  • Thanks 1
رابط هذا التعليق
شارك

  • أفضل إجابة

لقد قمت بالبحث عن أصل الكود ووجدته على أحد المواقع الأجنبية
ووجدت دالة GetTickCount التي لو كانت موجودة ضمن مثال السائل لانتهى الموضوع من "زمان" وانتهت معه هذه المعاناة.
حتى لا يتوه السائل أضفت صناديق بنفس الأسماء وبدلت أسماء باقي المكونات أيضا.
أعتقد الآن الموضوع منتهي ولا حاجة لانتظار الإجابة.
نسخة مع التحية للأستاذ @jjafferr

StopwatchTimer_01.rar

  • Like 2
رابط هذا التعليق
شارك

في 27‏/11‏/2022 at 12:38, AbuuAhmed said:

لقد قمت بالبحث عن أصل الكود ووجدته على أحد المواقع الأجنبية
ووجدت دالة GetTickCount التي لو كانت موجودة ضمن مثال السائل لانتهى الموضوع من "زمان" وانتهت معه هذه المعاناة.
حتى لا يتوه السائل أضفت صناديق بنفس الأسماء وبدلت أسماء باقي المكونات أيضا.
أعتقد الآن الموضوع منتهي ولا حاجة لانتظار الإجابة.
نسخة مع التحية للأستاذ @jjafferr

StopwatchTimer_01.rar 248.96 kB · 9 downloads

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

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information