Foksh

النسخة الجديدة والمطورة مع بعض اللمسات 1. حفظ القيم في الجدول من خلال زر جديد = Go 2. تمييز الجهاز المشغول باللون الأخضر ، وعند الإيقاف الؤقت باللون الأحمر ، وعند الأيقاف التام باللون البني . وعند الحفظ يعود الى اللون الأسود الباقي أتركه لكم لإكتشافه PlayStation.accdb

بالنسبة لهذه النقطة تم حلها ، واعتقد ان الليبل أفضل في المؤقتات والقيم الوقتية لإنه غير قابل للتركيز كما هو الحال في مربع النص ستضطر لقفله وعدم تمكينه. وسيتم إرفاق النسخة الجديدة مع تخزين القيم كما هي في الجدول. أشكرك أخي أحمد على ذوقك 😇 وللأسف تم إنشاء جدول واحد كما قلت لك لتخزين القيم كما هي وبنفس التنسيقات في الجدول 😉 💡 بالنسبة للترميش كان سببه الصورة التي في النموذج.

تم استخدام الخاصية Tag لكل جهاز ، حيث ما يلي :- أزرار البدء والإيقاف Tag = Station1 للجهاز الأول ... وهكذا لكل جهاز ( Station2 ، Station3 ... إلخ ) مربعات النص والليبلات Tag = St1 للجهاز الأول ... وهكذا لبقية الأجهزة ( St2 ، St3 ... إلخ ) شرح الكود بشكل مبسط وليس تفصيلاً :- في البداية تم حجز متغيرات عامة قابل للتعديل لتخزين القيم الزمنية للعدادات الستة و لتحديد ما إذا كان العداد قيد التشغيل أم لا و لتحديد ما إذا كان العداد متوقف مؤقتًا أم لا و لتخزين القيم الزمنية عند توقف العداد مؤقتًا . وطبعاً العدد 6 قابل للتعديل كيفما تريد . Dim counters(1 To 6) As Double Dim isRunning(1 To 6) As Boolean Dim isPaused(1 To 6) As Boolean Dim pauseCounters(1 To 6) As Double في الحدث عند التحميل كود لجعل الأزرار بالتسمية التوضيحية Start , Stop ، والعدادات قيمتها الإفتراضية = 00:00:00 ، والفاصل الزمني = 1 ثانية ( 1000 ملي ثانية ) Dim i As Integer For i = 1 To 6 counters(i) = 0 isRunning(i) = False isPaused(i) = False pauseCounters(i) = 0 Me.Controls("lblCounter" & i).Caption = "00:00:00" Me.Controls("TOTEL" & i).Value = 0 Me.Controls("cmdStartStop" & i).Caption = "Start" Me.Controls("cmdReset" & i).Caption = "Stop" Next i Me.TimerInterval = 1000 في الزر cmdStartStop هو المسؤول عن بدي وإيقاف مؤقت للتايمر مع تغيير حالة التسمية التوضيحية لكل زر حسب i ، حيث تم تسمية كل زر cmdStartStop بإضافة رقم يمثل رقم الجهاز للتمييز بينهم عند استدعاء الكود .. وكذلك الأمر عند الزر cmdReset المسؤول عن الإيقاف وإعادة تصفير العداد والقيم في كل جهاز ، ونفس الفكرة بالنسبة للتسمية التي تميز كل زر جهاز عن الآخر باستعمال المتغير i . وباقي الأجزاء الصغيرة واضحة ولا تحتاج شرح . Private Sub cmdStartStop_Click(Index As Integer) Dim stationId As Integer Dim startStopButton As Control Dim resetButton As Control stationId = Index Set startStopButton = Me.Controls("cmdStartStop" & stationId) Set resetButton = Me.Controls("cmdReset" & stationId) If startStopButton.Caption = "Start" Then startStopButton.Caption = "Pause" isRunning(stationId) = True isPaused(stationId) = False If counters(stationId) = 0 Then counters(stationId) = 0 Else counters(stationId) = pauseCounters(stationId) End If ElseIf startStopButton.Caption = "Pause" Then startStopButton.Caption = "Resume" isRunning(stationId) = False isPaused(stationId) = True pauseCounters(stationId) = counters(stationId) ElseIf startStopButton.Caption = "Resume" Then startStopButton.Caption = "Pause" isRunning(stationId) = True isPaused(stationId) = False counters(stationId) = pauseCounters(stationId) End If End Sub Private Sub cmdReset_Click(Index As Integer) Dim stationId As Integer Dim resetButton As Control Dim counterLabel As Control Dim totalCostBox As Control Dim startStopButton As Control stationId = Index Set resetButton = Me.Controls("cmdReset" & stationId) Set counterLabel = Me.Controls("lblCounter" & stationId) Set totalCostBox = Me.Controls("TOTEL" & stationId) Set startStopButton = Me.Controls("cmdStartStop" & stationId) If resetButton.Caption = "Stop" Then resetButton.Caption = "Reset" isRunning(stationId) = False isPaused(stationId) = True pauseCounters(stationId) = counters(stationId) ElseIf resetButton.Caption = "Reset" Then resetButton.Caption = "Stop" counterLabel.Caption = "00:00:00" counters(stationId) = 0 totalCostBox.Value = 0 isRunning(stationId) = False isPaused(stationId) = False pauseCounters(stationId) = 0 startStopButton.Caption = "Start" End If End Sub التركيز كله على الحدث عند الوقت ، وهو يحدث في كل ثانية العملية الحسابية لكل جهاز بشكل مستقل لا يؤثر على الآخر بالإعتماد على المتغيرات التي في الأسماء وهو الرقم i الذي يمثل رقم الجهاز ( لاحظ التسميات لهذه العناصر في النموذج ستعرف المقصود ) . والعملية الحسابية تقوم بتقسيم القيمة في STSATR_DATE لكل جهاز حساب التكلفة الإجمالية للعداد الحالي بناءً على معدل الساعة وإجمالي الثواني. ( طبعاً متغيرات كثيرة لم أتطرق لها لضيق الوقت ) . Private Sub Form_Timer() Dim i As Integer Dim totalSeconds As Long Dim hourlyRate As Double Dim totalCost As Double For i = 1 To 6 If isRunning(i) And Not isPaused(i) Then counters(i) = counters(i) + 1 Me.Controls("lblCounter" & i).Caption = Format(DateAdd("s", counters(i), "00:00:00"), "hh:mm:ss") hourlyRate = Me.Controls("STSATR_DATE" & i).Value totalSeconds = counters(i) totalCost = (hourlyRate / 3600) * totalSeconds Me.Controls("TOTEL" & i).Value = Format(totalCost, "0.00") End If Next i End Sub وفي النهاية استدعاء الأمر لكل زر (cmdStartStop1 ، cmdStartStop2 ... إلخ ) و (cmdReset1 ، cmdReset2 ... إلخ ) حسب تسميته Private Sub cmdStartStop1_Click() Call cmdStartStop_Click(1) End Sub Private Sub cmdStartStop2_Click() Call cmdStartStop_Click(2) End Sub Private Sub cmdStartStop3_Click() Call cmdStartStop_Click(3) End Sub Private Sub cmdStartStop4_Click() Call cmdStartStop_Click(4) End Sub Private Sub cmdStartStop5_Click() Call cmdStartStop_Click(5) End Sub Private Sub cmdStartStop6_Click() Call cmdStartStop_Click(6) End Sub Private Sub cmdReset1_Click() Call cmdReset_Click(1) End Sub Private Sub cmdReset2_Click() Call cmdReset_Click(2) End Sub Private Sub cmdReset3_Click() Call cmdReset_Click(3) End Sub Private Sub cmdReset4_Click() Call cmdReset_Click(4) End Sub Private Sub cmdReset5_Click() Call cmdReset_Click(5) End Sub Private Sub cmdReset6_Click() Call cmdReset_Click(6) End Sub وسلاااااامتك يا صديقي

غير صحيح ,, كل جهاز له قيمة مختلفة ، وانا غيرت القيم في كل جهاز علشان تتأكد من هاي الفكرة لاحظ هذا الجزء في السطر ، i هي متغير لرقم مربع النص حسب رقم الجهاز Me.Controls("STSATR_DATE" & i).Value

جلست أكثر من 3 دقائق أتمعن في هذه الجملة !!!! تريد حذف الكائنات التي لا تحتاجها ؟؟؟؟؟؟ اضغط على أي كائن زي يمين بالماوس واختر Delete - حذف أو لا تبخل علينا بالتوضيح والفكرة التي تدور في رأسك

وهذه فكرتي المتواضعة والقابلة للتطوير بشكل بسيط جداً ,, TEST_2.accdb

استغفر الله العظيم اخي العزيز أحمد ،، كلنا نتعلم من بعضنا اخي الكريم ، وقد ترى انت شيء لم انتبه له ، وهذا يسعدني جداً 🥰

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

إن شاء الله الأمر بسيط ، ولكني فعلاً الآن خارج المنزل وبعيد عن الكمبيوتر 😇

أخت @hanan_ms ، كلامك صحيح 😁 ولكن هنا التنفيذ كان حسب الطلب ، ولو جينا نتفرع وناشعب في الموضوع فسنجد أنفسنا موظفين في مركز وسنتر بلايستيشن 😂 إحنا على رأي الأخ @حسين العربى

جميل جداً ،،

اعتذر فعلاً ، لإن الصفحة كانت مفتوحة عند رد معلمي وأستاذي أبو خليل ولم أقم بالتحديث ( متابع من الجوال 😅 ) كلامك صحيح ، والروقان هييجي بعد ما اعمل ريفريش لكل صفحة علشان أحفظ خط الرجعة 🤣😂 جايلك يا حبيبي جايلك ، بس أما أروووق

إنت جيييييت ، تعال على جنب عاوزك في كلمتين ونص 🤣😂 الجداول دي مسؤولية صاحب الموضوع على حد علمي لما هو يريد ، ويمكن ما عندوش جرد ولا حسابات اذا كان السنتر 6 أجهزة مثلاً.. بالنسبة لموضوع فصل كل جهاز بعداد منفصل فدي حاجة بسيطة عليك طبعاً ، بس حظك الحلو إني خرجت لبيت أهلي ، وأول ما أرجع هنتقابل بالساحة ونفرد عضلاتنا وسط الناس 😁 وما تخافش ، أصلي حنين 🤣😂🤣😂

قد يكون الترتيب التالي أفضل 1. حذف الجدول المستهدف كاملاً ، 2. إنشاء نسخة ثانية من الجدول المصدر ، 3. إعادة تسمية الجدول الجديد بالاسم المطلوب ، 4. جملة استعلام حذف جميع السجلات في الجدول الجديد ، وهذا كفيل بإبقاء التسمية التوضيحية موجودة كما في الجدول الأصل ( المصدر ) * وجهة نظر قابلة للنقاش

شكراً لك أخي @ahmed draz على هذه الثقة ، وثق تماماً أنني ما زلت أتعلم من هذا المنتدى ومن الخبرات القوية التي تختفي تحت أسماء عظيمة في هذا القسم . هذا التعديل البسيط لما طلبت ، فتفضل :- Option Compare Database Option Explicit Dim counter As Double Dim isRunning As Boolean Dim isPaused As Boolean Dim pauseCounter As Double Private Sub Form_Load() counter = 0 isRunning = False isPaused = False pauseCounter = 0 Me.lblcounter.Caption = "00:00:00" Me.TOTEL_1.Value = 0 Me.TimerInterval = 1000 End Sub Private Sub cmdstart_Click() If Me.cmdstart.Caption = "Start" Then ' ÈÏÁ ÇáÚÏ Me.cmdstart.Caption = "Pause" Me.TimerInterval = 1000 counter = 0 isRunning = True isPaused = False pauseCounter = 0 ElseIf Me.cmdstart.Caption = "Pause" Then Me.cmdstart.Caption = "Resume" Me.TimerInterval = 0 isRunning = False isPaused = True pauseCounter = counter ElseIf Me.cmdstart.Caption = "Resume" Then Me.cmdstart.Caption = "Pause" Me.TimerInterval = 1000 counter = pauseCounter isRunning = True isPaused = False End If End Sub Private Sub cmdReset_Click() Me.cmdstart.Caption = "Start" Me.lblcounter.Caption = "00:00:00" counter = 0 Me.TimerInterval = 0 Me.TOTEL_1.Value = 0 isRunning = False isPaused = False pauseCounter = 0 End Sub Private Sub Form_Timer() Dim totalSeconds As Long Dim hourlyRate As Double Dim totalCost As Double If isRunning And Not isPaused Then counter = counter + 1 Me.lblcounter.Caption = Format(DateAdd("s", counter, "00:00:00"), "hh:mm:ss") hourlyRate = Me.STSATR_DATE.Value totalSeconds = counter totalCost = (hourlyRate / 3600) * totalSeconds Me.TOTEL_1.Value = Format(totalCost, "0.00") End If End Sub

هذا الخلل قد يكون ناتج عن عدم وجود تسمية توضيحية لبعض الحقول ، إن لم أكن مخطئاً .. محاولةً لتلافي وتجاوز الحقول التي ليس لها تسمية توضيحية جرب الكود بالتعديل التالي :- Private Sub Cmd2_Click() Dim Msg, Style, Title, result Msg = "سيتم الآن حذف جدول الصف الثاني! ننصح بتصدير الصف الثاني إلى الثالث أولاً!!! هل ترغب في الاستمرار؟؟" Style = vbInformation + vbYesNo + vbMsgBoxRight Title = "تحذير - حذف جدول الصف الثاني" result = MsgBox(Msg, Style, Title) If result = vbYes Then DoCmd.SetWarnings False DoCmd.DeleteObject acTable, "tbl_student2" DoCmd.RunSQL "SELECT tbl_student.* INTO tbl_student2 FROM tbl_student;" Dim db As DAO.Database Dim tdfSource As DAO.TableDef Dim tdfDest As DAO.TableDef Dim fldSource As DAO.Field Dim fldDest As DAO.Field Set db = CurrentDb Set tdfSource = db.TableDefs("tbl_student") Set tdfDest = db.TableDefs("tbl_student2") For Each fldSource In tdfSource.Fields For Each fldDest In tdfDest.Fields If fldDest.Name = fldSource.Name Then On Error Resume Next Dim prop As DAO.Property Set prop = fldSource.Properties("Caption") If Err.Number = 0 Then fldDest.Properties("Caption").Value = prop.Value End If On Error GoTo 0 End If Next fldDest Next fldSource MsgBox "تم حذف جدول الصف الثاني وإحلال محتويات الصف الأول في جدول جديد باسم الصف الثاني", vbOKOnly + vbMsgBoxRight, "إعلام حذف" DoCmd.SetWarnings True ElseIf result = vbNo Then DoCmd.CancelEvent MsgBox "!!! لقد تم إيقاف عملية الحذف", vbOKOnly + vbMsgBoxRight, "إعلام توقف عن الحذف" End If End Sub

مشاركة مع الأخ @ahmed draz ، استبدل كود النموذج كاملاً بالتالي :- Option Compare Database Option Explicit Dim counter As Double Private Sub cmdReset_Click() Me.cmdstart.Caption = "Start" Me.lblcounter.Caption = "00:00:00" counter = 0 Me.TimerInterval = 0 Me.TOTEL_1.Value = 0 End Sub Private Sub cmdstart_Click() If Me.cmdstart.Caption = "Start" Then Me.cmdstart.Caption = "Stop" Me.TimerInterval = 1000 counter = 0 Else Me.cmdstart.Caption = "Start" Me.TimerInterval = 0 End If End Sub Private Sub Form_Load() counter = 0 End Sub Private Sub Form_Timer() Dim totalSeconds As Long Dim hourlyRate As Double Dim totalCost As Double counter = counter + 1 Me.lblcounter.Caption = Format(DateAdd("s", counter, "00:00:00"), "hh:mm:ss") hourlyRate = Me.STSATR_DATE.Value totalSeconds = counter totalCost = (hourlyRate / 3600) * totalSeconds Me.TOTEL_1.Value = Format(totalCost, "0.00") End Sub

لعدم وجود اوفيس 2003 ، جرب اضافة المكتبة Microsoft DAO 3.6 Object

وانت عمال تقوله خد راحتك 😂 اتفضل ،، اهو نسي يرفع الملف من الفرحة 😂😂😁 قال ينبسط قال ، يا حبيبي انا لما اشوف اسمع ببقى عامل زي العصفور اللي طاير من الفرحة 🤣

جرب التعديل التالي :- Private Sub Cmd2_Click() Dim Msg, Style, Title, result Msg = "سيتم الآن حذف جدول الصف الثاني! ننصح بتصدير الصف الثاني إلى الثالث أولاً!!! هل ترغب في الاستمرار؟؟" Style = vbInformation + vbYesNo + vbMsgBoxRight Title = "تحذير - حذف جدول الصف الثاني" result = MsgBox(Msg, Style, Title) If result = vbYes Then DoCmd.SetWarnings False DoCmd.DeleteObject acTable, "tbl_student2" DoCmd.RunSQL "SELECT tbl_student.* INTO tbl_student2 FROM tbl_student;" Dim db As DAO.Database Dim tdfSource As DAO.TableDef Dim tdfDest As DAO.TableDef Dim fldSource As DAO.Field Dim fldDest As DAO.Field Set db = CurrentDb Set tdfSource = db.TableDefs("tbl_student") Set tdfDest = db.TableDefs("tbl_student2") For Each fldSource In tdfSource.Fields For Each fldDest In tdfDest.Fields If fldDest.Name = fldSource.Name Then fldDest.Properties("Caption").Value = fldSource.Properties("Caption").Value End If Next fldDest Next fldSource MsgBox "تم حذف جدول الصف الثاني وإحلال محتويات الصف الأول في جدول جديد باسم الصف الثاني", vbOKOnly + vbMsgBoxRight, "إعلام حذف" DoCmd.SetWarnings True ElseIf result = vbNo Then DoCmd.CancelEvent MsgBox "!!! لقد تم إيقاف عملية الحذف", vbOKOnly + vbMsgBoxRight, "إعلام توقف عن الحذف" End If End Sub

Private Sub Cmd2_Click() DoCmd.SetWarnings False DoCmd.DeleteObject acTable, "tbl_student2" DoCmd.RunSQL "SELECT tbl_student.* INTO tbl_student2 FROM tbl_student;" DoCmd.SetWarnings True End Sub

هههههههه بعد ما ذكره ولا قبل !!!!! نروح الشهر العقاري واتنازل لك فيه , بس انت حدد يوم

للأسف ليس لدي إصدار أوفيس 2003 ، ولكن كتعديل جرب هذا الكود :- Private Sub Command0_Click() Dim db As DAO.Database Dim tblName As String Dim newTblName As String Dim tempTblName As String Dim tdf As DAO.TableDef tblName = "tbl_student" newTblName = "tbl_student2" tempTblName = "temp_" & newTblName Set db = CurrentDb On Error Resume Next Set tdf = db.TableDefs(tempTblName) If Not tdf Is Nothing Then db.TableDefs.Delete tempTblName End If Set tdf = Nothing On Error GoTo 0 DoCmd.CopyObject , tempTblName, acTable, tblName On Error Resume Next Set tdf = db.TableDefs(newTblName) If Not tdf Is Nothing Then db.TableDefs.Delete newTblName End If Set tdf = Nothing On Error GoTo 0 db.TableDefs(tempTblName).Name = newTblName Set db = Nothing MsgBox "Table " & newTblName & " has been successfully recreated from " & tblName, vbInformation End Sub

وعليكم السلام ورحمة الله وبركاته ،، أخي الكريم أهلا وسهلاً بك في مجتمعنا المتواضع ، ونتمنى أن تجد الفائدة التي تبحث عنها . اسمح لي بتذكيرك لنقاط مهمة حتى تحصل على إجابة سريعة و واضحة :- أولاً أجعل العنوان يدل على المشكلة دون مقدمات .. ثانياً في الشرح بارك الله فيك لم تقصر جاهداً في التوضيح إلا أنك لم تذكر اسم النموذج أو التقرير ..... (تركت الأمر معلقاً ) ثالثاً ونصيحة حاول الابتعاد عن المسميات العربية للجداول والحقول والعناصر والكائنات لأنها تربكك في الأكواد والإستعلامات . بعد تجربة المرفق ، جرب اعمل تجميع في الإستعلام "استعلام الخطة العامة"

نفس الكود في مرفق ، جربته ويعمل بكفاءة Copy TBL.accdb