AbuuAhmed

تم تنفيذ المطلوب وزيادة تطبيق لون_09.accdb

نسخة تضم تعديلي وتعديلك. MZ_SUB 10.rar

إذن احذف مرفقك الأخير وأنا أحذف مرفقي الأخير وسأرفع مرفق جديد به تعديلك وتعديلي.

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

بس اكتشفت خلل 🙂 ، سأرجع لكم بنسخة أخرى وبعد المراجعة لم يكن خللا بل مجرد شك 🙂

كنت ناسيها ، تم الاستفادة من خاصية Tag

وهذه مساهمة إضافية مني awad77_03.xlsm

نبارك لكم الترقية وإلى المزيد من الصولات والجولات القادمة

تم التعديل ، وهذه المرة انسخ الكود كاملا لأنه حصل أكثر من تعديل. وقد يكون غير جيد لتحميل الشجرة. لا أعرف لماذا ثلاثة معرفات ID و Code و TNO؟ حاليا أرى أن لاحاجة لحقل ID وإذا أردت ربطه بجدول آخر فاربطه بحقل Code كذلك حقل TNO لماذا هو "كسري" إن صح التعبير أي Double لماذا لا يكون Integer أو Long Integer؟ MZ_SUB 07.rar

جرب الآن والتعديل في الآتي: 'rst.Sort = "LVLno,Parent,Code" 'ترتيب نصي rst.Sort = "LVLno,CLng(Parent),CLng(Code)" 'ترتيب رقمي وهنا أيضا: For Each nodX In TreeView6.Nodes nodX.EnsureVisible nodX.Expanded = False 'nodX.Sorted = True 'لا تستخدم هذا السطر لأنه سيخرب الترتيب السابق nodX.Bold = True nodX.Selected = False Next MZ_SUB 05.rar

تم التعديل على جدول الموضوعات بتبديل اسم حقلين No1 ، No2 وتم إضافة حقل Error لمعرفة السجلات التي فشلت في الإضافة. التعديل على الأسماء لتساعدني في التركيز ، وأنصح دائما باستخدام اسماء تدل على معناها. كذلك قمت بتقليص طول الحقلين أعلاه إلى 50 رمز وأنصح بتقليصه من طرفكم بعد التأكد من أقصى طول مطلوب. جدول TAB_Subject_X يجب تبديل حقل ID من AutoNumber إلى Number العلاقات بين الجداول تحتاج إلى إعادة دراسة استعن بغيري 🙂 . تم تصحيح الكود ليصبح كالتالي: Set rst = dbs.OpenRecordset("TAB_Subject", dbOpenDynaset) rst.Sort = "LVLno,Parent,Code" 'جديد Set rst = rst.OpenRecordset 'جديد Set nodX = TreeView6.Nodes.Add(, , "A", "الموضوعات") With rst Do While Not .EOF Err.Clear Set nodX = TreeView6.Nodes.Add("A" & CStr(Nz(!Parent, "")), _ tvwChild, "A" & CStr(!Code), _ CStr(!Code) & ":" & !Sname) 'مؤقتا حتى يتم التأكد من سلامة كل البيانات ------------ .Edit !Error = Err.Number <> 0 .Update '----------------------------------------------------- 'If Err.Number = 0 Then nodX.EnsureVisible 'هذا السطر يسبب بطء شديد .MoveNext Loop 'مؤقتا حتى يتم التأكد من سلامة كل البيانات ------------ MsgBox "إجمالي السجلات: " & .RecordCount & vbCrLf & _ "السجلات المضافة: " & TreeView6.Nodes.Count & vbCrLf & _ "السجلات الفاشلة: " & .RecordCount - TreeView6.Nodes.Count _ & vbCrLf & vbCrLf & _ "راجع جدول الموضوعات حقل Error" '----------------------------------------------------- End With rst.Close MZ_SUB 04b.rar

وأكثر من ربع ساعة وأنا أعمل تحديث للصفحة وأقطع النت وأشبك من جديد وأقفل المستعرض وأفتحه من جديد والاسم عالق أسفل الشاشة لا أخفيكم سرا أنا غير مطمئن من هذه "الشغلة"

هذا الكود قبل أن ينشأ موقع أوفيسنا أو مع بدايته 🙂 وكثير يسيئ استخدامه لأن البيانات تحتاج إلى ترتيب أولا ، فلا بد من إضافة الأب قبل الإبن حتى يتم تحميل الإبن وإلا ستفشل عملية تحميل الإبن. رجعت لقاعدة البيانات خاصتك وفي جدول الموضوعات ولم أعرف أحدد الأب من الإبن "ضاعت الأنساب" 🙂 ، فهل تستطيع توضح لي مثال/سطر واحد وكيفية ربط الإبن بالأب؟. كذلك إذا الشجرة فقط للعرض ليس بها إضافة ولا تعديل ولا حذف فيفضل عدم استخدام النوع dbOpenDynaset بل يستخدم dbOpenSnapshot

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

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

جرب هذا الكود بعد التنقيح ولا تنسى أن تقرأ ملاحظاتي في مشاركاتي السابقة. 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

لن أنتظر بعض الملاحظات على الكود: 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

بالصدفة حصلت معاي مشكلة ربما تشبه ما قاله الأخ @qathi وبالتحري 🙂 وجدت المشكلة في الحصول على عدد السجلات والذي نحصل عليه من: Me.RecordsetClone.RecordCount حيث يعطي أحيانا العدد واحد بدلا من المجموع، وكان حلي للمشكلة في حدث عند فتح النموذح بهذه الطريقة: Private Sub Form_Open(Cancel As Integer) On Error Resume Next DoCmd.GoToRecord , , acLast DoCmd.GoToRecord , , acFirst End Sub والآن أرفع لكم نسخة أخرى بعد التعديل. تطبيق لون_08.accdb

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

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

العين ما تعلى على الحاجب أستاذنا العزيز اساتذتنتا القدامى "عبق الماضي" لهم مكانة خاصة ولا يهون أصحاب القلوب الطيبة.

جرب الآن ، أنا بدلت المرفق ، والأمور عندي ممتازة.

جرب الآن تطبيق لون_07.accdb

ما نسيت ، بس سطري كان طرق باب ، ولم أتلقى الجواب 🙂 الآن بما أنك رديت على طرق الباب أضع لك المثال. طبعا يمكن عملها بدون استخدام زر ، ممكن من حدث DblClick لصندوق اللون. تطبيق لون_05.accdb

موضوع شيق، هل جربتم اسخدام هذا الأمر؟ : Call Application.Run("DialogColor", vbBlue)