كل الانشطه

تقدّم شركة سندك للاستشارات الأكاديمية والترجمة، دعمًا متكاملًا للباحثين من خلال خدمة إعداد خطة البحث، وما يتصل بها من مساعدة في إعداد خطة بحث لضمان إعداد دراسة أكاديمية منظمة واحترافية. ويبرز في هذا الإطار موضوع خطة بحث علمي | خطوات كتابة خطة بحث جامعي احترافية PDF الذي يُعد دليلاً عمليًا للباحثين. كما يشمل هذا المجال خطوات كتابة خطة البحث التي توضح ترتيب ومراحل إعداد الخطة، إلى جانب مكونات خطة البحث التي تحدد العناصر الأساسية لأي خطة منهجية متكاملة. https://www.sanadkk.com/blog/post/1791/%D8%AE%D8%B7%D8%A9-%D8%A8%D8%AD%D8%AB-%D8%B9%D9%84%D9%85%D9%8A.html

خطة بحث في الإمارات | خبرة أكاديمية وحلول مبتكرة من سندك تُعد خطوة أساسية لفهم طبيعة البحث وتنظيمه وفق أسس علمية دقيقة. وتشمل دراسة على ماذا تحتوي خطة البحث؟، لتوضيح جميع عناصر البحث وأهدافه. كما تسلّط الضوء على عمل بحوث جامعية في الإمارات الذي يتيح للطلاب تنفيذ الدراسات وفق معايير أكاديمية رصينة. وتقدّم شركة سندك للاستشارات الأكاديمية والترجمة، خبرتها لدعم الباحثين والطلاب في إعداد أبحاثهم. بالإضافة إلى ذلك توفر خدمة إعداد خطة البحث، لتسهيل تنظيم الدراسة خطوة بخطوة. وبجانب ذلك تقدم سندك مساعدة في إعداد خطة بحث لضمان تنفيذ البحث بدقة واحترافية عالية. https://www.sanadkk.com/blog/post/1792/%D8%AE%D8%B7%D8%A9-%D8%A8%D8%AD%D8%AB-%D9%81%D9%8A-%D8%A7%D9%84%D8%A5%D9%85%D8%A7%D8%B1%D8%A7%D8%AA.html

مراحل البحث التربوي | كيف تبدأ بحثك بخطوات صحيحة وعناصر متكاملة؟ تُعد خطوة أساسية لفهم مسار الدراسة وضمان تنفيذ البحث بشكل صحيح ومنهجي. ويشمل ذلك إعداد البحث التربوي الذي يحدد أهداف الدراسة والإطار المنهجي لها. كما يسلط الضوء على عناصر البحث التربوي التي تضمن اكتمال الدراسة ووضوح النتائج. وتقدّم شركة سندك للاستشارات الأكاديمية والترجمة، خبرتها لدعم الباحثين في مختلف مراحل إعداد البحث. بالإضافة إلى ذلك توفر خدمة إعداد خطة البحث، لتسهيل وضع خطة منظمة وواضحة. وبجانب ذلك تقدم سندك مساعدة في إعداد خطة بحث لضمان صياغة دراسة متكاملة واحترافية في كل مراحلها. https://www.sanadkk.com/blog/post/1810/%D9%85%D8%B1%D8%A7%D8%AD%D9%84-%D8%A7%D9%84%D8%A8%D8%AD%D8%AB-%D8%A7%D9%84%D8%AA%D8%B1%D8%A8%D9%88%D9%8A.html

مراحل تصميم البحوث التربوية | خطوات البحث وخصائص التصميم الجيد مع أمثلة تطبيقية تعد خطوة أساسية لفهم طبيعة البحث وتنظيمه بشكل منهجي، حيث يساهم التصميم الجيد في تحقيق نتائج دقيقة وموثوقة. ويشمل ذلك تصميم البحث التربوي الذي يحدد إطار الدراسة ومنهجيتها. كما يسلط الضوء على خطوات البحث التربوي التي يجب اتباعها لضمان سير الدراسة بشكل منطقي ومنظم. وتقدّم شركة سندك للاستشارات الأكاديمية والترجمة، دعمًا متخصصًا للباحثين في جميع مراحل البحث. بالإضافة إلى ذلك توفر خدمة إعداد خطة البحث، لتسهيل وضع خطة متكاملة وواضحة. وبجانب ذلك تقدم سندك مساعدة في إعداد خطة بحث لضمان أن تكون الدراسة دقيقة ومنهجية واحترافية في تنفيذها. https://www.sanadkk.com/blog/post/1823/%D9%85%D8%B1%D8%A7%D8%AD%D9%84-%D8%AA%D8%B5%D9%85%D9%8A%D9%85-%D8%A7%D9%84%D8%A8%D8%AD%D9%88%D8%AB-%D8%A7%D9%84%D8%AA%D8%B1%D8%A8%D9%88%D9%8A%D8%A9.html

اختيار عنوان بحث علمي | أهم المعايير والأفكار الملهمة لاختيار عنوان مميز لبحثك يمثل خطوة محورية في نجاح أي دراسة، إذ يوجه القارئ نحو محتوى البحث ويعكس أهميته. كما يجب مراعاة شروط عنوان البحث العلمي لضمان وضوحه ودقته، مع التركيز على أهمية عنوان البحث العلمي في تعزيز التميز الأكاديمي وجذب الانتباه للبحث. وتقدّم شركة سندك للاستشارات الأكاديمية والترجمة، خبرتها لدعم الباحثين في هذه المرحلة. كما توفر الشركة خدمة إعداد خطة البحث، مما يسهل على الباحث تنظيم خطواته بدقة. وبالإضافة إلى ذلك تقدم سندك مساعدة في إعداد خطة بحث لضمان اختيار عنوان متقن يعكس محتوى الدراسة بدقة واحترافية. https://www.sanadkk.com/blog/post/1863/%D8%A7%D8%AE%D8%AA%D9%8A%D8%A7%D8%B1-%D8%B9%D9%86%D9%88%D8%A7%D9%86-%D8%A7%D9%84%D8%A8%D8%AD%D8%AB-%D8%A7%D9%84%D8%B9%D9%84%D9%85%D9%8A.html

أخطاء اختيار مشكلة البحث | دليل لتحديد وصياغة مشكلة بحثية سليمة خطوة بخطوة يُقدّم إرشادًا عمليًا يساعد الباحث على تجنّب المزالق الشائعة عند صياغة إشكالية الدراسة، ويتصل به فهم واضح لـ مفهوم مشكلة البحث العلمي، الذي يوضح طبيعة الإشكالية وموقعها داخل الإطار المعرفي للبحث. كما لا بد من مراعاة شروط مشكلة البحث لضمان أن تكون المشكلة قابلة للدراسة ومحددة وذات أهمية علمية واضحة، وفي هذا السياق تقدم شركة سندك للاستشارات الأكاديمية والترجمة، دعماً منهجياً ونصحاً احترافياً للباحثين. وتكمل الشركة خدماتها عبر خدمة إعداد خطة البحث، ومساعدة في إعداد خطة بحث لتمكين الباحثين من الانتقال من صياغة المشكلة إلى خطة منهجية قابلة للتنفيذ وتحقيق نتائج علمية موثوقة. https://www.sanadkk.com/blog/post/1864/%D8%A7%D8%AE%D8%B7%D8%A7%D8%A1-%D8%A7%D8%AE%D8%AA%D9%8A%D8%A7%D8%B1-%D9%85%D8%B4%D9%83%D9%84%D8%A9-%D8%A7%D9%84%D8%A8%D8%AD%D8%AB.html

أخلاقيات البحث العلمي | كيف تلتزم بالمصداقية والشفافية في أبحاثك العلمية؟ ويبرز في هذا السياق مفهوم أخلاقيات البحث العلمي، إذ تُعد هذه الأخلاقيات أساسًا لضمان جودة الدراسات وموثوقيتها، مما يوضح أهمية أخلاقيات البحث العلمي لكل باحث يسعى للالتزام بالمعايير الأكاديمية. كما تقدّم شركة سندك للاستشارات الأكاديمية والترجمة، خدمة إعداد خطة البحث دعمًا متخصصًا للباحثين، وتوفر كذلك مساعدة في إعداد خطة بحث تساعدهم على تطبيق الأخلاقيات العلمية في دراساتهم بفعالية واحترافية. https://www.sanadkk.com/blog/post/1866/%D8%A3%D8%AE%D9%84%D8%A7%D9%82%D9%8A%D8%A7%D8%AA-%D8%A7%D9%84%D8%A8%D8%AD%D8%AB-%D8%A7%D9%84%D8%B9%D9%84%D9%85%D9%8A.html

مقدمة بحث وخاتمة علمية | أسرار البداية والنهاية لبحث متكامل وناجح ويُعد هذا الموضوع محوريًا لفهم كيفية إعداد مقدمة بحث وخاتمة، إذ تساعد المقدمة الواضحة في تحديد الهدف من مقدمة البحث بشكل دقيق. وتقدّم شركة سندك للاستشارات الأكاديمية والترجمة، خدمة إعداد خطة البحث دعمًا أكاديميًا متخصصًا للباحثين، كما توفر أيضًا مساعدة في إعداد خطة بحث لضمان كتابة مقدمة وخاتمة متكاملة تؤسس لبحث ناجح من بدايته حتى نهايته. https://www.sanadkk.com/blog/post/2047/%D9%85%D9%82%D8%AF%D9%85%D8%A9-%D8%A8%D8%AD%D8%AB-%D9%88%D8%AE%D8%A7%D8%AA%D9%85%D9%87.html

مقدمة البحث كم صفحة؟ دليلك لكتابة مقدمة علمية صحيحة مع أمثلة PDF ويعد هذا الموضوع جزءًا أساسيًا من كتابة مقدمة البحث العلمي، حيث يحتاج الباحث إلى فهم قواعد الصياغة السليمة. ولتحقيق جودة أكاديمية عالية يجب الالتزام بـ شروط مقدمة البحث التي تضمن وضوح الفكرة وترابطها. وتقدم شركة سندك للاستشارات الأكاديمية والترجمة، خبرتها للطلاب والباحثين في هذا المجال. كما توفر خدمات احترافية مثل خدمة إعداد خطة البحث، لتسهيل تنظيم خطوات الدراسة العلمية. إضافة إلى ذلك تقدم الشركة أيضًا مساعدة في إعداد خطة بحث لضمان صياغة مقدمة دقيقة وبداية بحث قوية. https://www.sanadkk.com/blog/post/2048/%D9%85%D9%82%D8%AF%D9%85%D8%A9-%D8%A7%D9%84%D8%A8%D8%AD%D8%AB-%D9%83%D9%85-%D8%B5%D9%81%D8%AD%D8%A9.html

ماذا أكتب في مقدمة البحث؟ خطوات وشروط صياغة مقدمة علمية ناجحة تأتي أهمية هذا الموضوع ضمن إطار مقدمة البحث العلمي، حيث تمثل الخطوة الأولى لفهم محتوى الدراسة. وتعتمد جودة العمل الأكاديمي على الالتزام بـ شروط مقدمة البحث التي تضبط منهجية الباحث. وتحرص شركة سندك للاستشارات الأكاديمية والترجمة، من خلال خبرتها، على تقديم دعم احترافي للباحثين. وتوفر الشركة خدمات متخصصة مثل خدمة إعداد خطة البحث، التي تساعد الطلاب في التنظيم العلمي. كما تقدم سندك كذلك مساعدة في إعداد خطة بحث لضمان انطلاقة بحثية قوية ومتكاملة. https://www.sanadkk.com/blog/post/2049/%D9%85%D8%A7%D8%B0%D8%A7-%D8%A7%D9%83%D8%AA%D8%A8-%D9%81%D9%8A-%D9%85%D9%82%D8%AF%D9%85%D8%A9-%D8%A7%D9%84%D8%A8%D8%AD%D8%AB.html

يتشرف #مركز_الرؤية_الاستراتيجية_للتدريب #Strategic_Vision_Training_Center لدعوة سيادتكم للأنضمام الي الدورات التدريبية التالية,,,,, #دورة #الجودة #الشاملة فى #المختبرات ISO 17025 #دورات #الجودة #الانتاج #iso اهداف البرنامج التدريبي • إمداد المتدربين بالمعرفة اللازمة في مجال الأمن والسلامة في المختبرات على سبل التعامل مع الحوادث والأخطار داخل بيئة المختبرات, وكذلك التعرف الى أدارة المختبرات طبقا لنظام المواصفات القياسية ISO 17025. المشاركين • جميع العاملين في مجال الامن و السلامة العامه • جميع العاملين في مجال امن وسلامة المباني و المنشأتوالمختبرات. رجال الامن والسلامه العامه في المؤسسات والمختبرات والشركات الهيئات الحكوميه. #دورات #الجودة #الانتاج #iso EMS / ISO 14001 (IEMA)دورة مدققي رئيسي دورة إدارة الجودة الإستراتيجية دورة الجودة الشاملة فى المختبرات ISO 17025 دورة إدارة الجودة في سلسلة التوريد دورة الأداء المؤسسي وفقاً لمعايير الأوروبي EFQM دورة التصميم من أجل الجودة دورة الممارسات الجيدة في المختبرات (GLP) دورة الجودة والتدقيق الفردي للأجهزة الطبية دورة تأهيل مديري الانتاج في المنشآت الصناعية دورة تدقيقات الجودة والجوائز والتنفيذ دورة تنمية مهارات إعداد خطط وبرامج التحفيز لزيادة الإنتاجية دورة التوعية والتنفيذ EMS / ISO 14001 دورة قيادة إدارة الجودة دورة نظم معلومات مراقبة الجودة والانتاج دورة إدارة الجودة فى سلسلة التوريد كما يتم تنفيذ #الدورات_التدريبية فى #المجالات_التدريبية الاتية : #الدورات الهندسية ) الكهربائية - الميكانيكية والسيارات - الهندسة المدنية والمشاريع والطرق - هندسة المساحة - الصيانة - البترول والجولوجيا( دورات البيئة وصحة وسلامة الغذاء دورات الامن الصناعي والسلامة والصحة المهنية دورات الامن دورات القانون والعقود دورات الجودة والأنتاج دورات القيادة والادارة دورات العلاقات العامة والدولية والاعلام دورات السكرتارية وادارة المكاتب دورات التسويق والمبيعات وخدمة العملاء دورات الموارد البشرية دورات المحاسبة والمالية دورات البنوك والمصارف دورات المشتريات والمخازن دورات النقل و اللوجستيات وادارة سلاسل التوريد أماكن الانعقاد ( #دبي #اسطنبول #كوالالمبور #المغرب #السعودية #شرم_الشيخ #القاهرة #الأسكندرية #لندن # اسبانيا #كندا ) الاعتمادات احصل الان على شهادتك باعتماد cpd الدولى كما يوجد خصم للشركات والهيئات والجهات الحكومية والمجموعات كما يتم تنفيذ أي دوره تدريبيه اخرى تلبي احتياجاتكم التدريبية بالوقت و بالمكان المناسبين لكم على ان يكون عدد المشاركين (2) كحد ادنى قاعات التنفيذ بفنادق 5 نجوم ذات الشهره العالميه مجهزه بالوسائل السمعيه والبصريه للتسجيل او لطلب العرض الفنى والمالى يرجى الاتصال او ارسال بريد الاكترونى Ahmed Mohamed WhatsApp 00201551848384 Training@svtcenter.com Facebook https://www.facebook.com/profile.php?id=100086139318374 Twitter https://twitter.com/StrategicVisio7 Linkedin https://www.linkedin.com/company/strategic-vision-training-center/ Instagram https://www.instagram.com/strategicvisiontrainingcenter WIX https://eslam-training.wixsite.com/training Website https:// svtcenter.com/ar/Home

اليك المرفق استاذ للتعديل علما اني موقف الكود القديم في حدث عند التحميل 'هنا كود الفصل القديم متوقف ' Dim LongName As String, Myst As Integer, Myend As Integer ' 'Valid for 5 Names only ' Dim PartName(5) As String, k As Integer ' LongName = Me.dal.Caption '.text 'Myst = 1 ' For i = 1 To Len(LongName) ' Myend = Myend + 1 ' If Mid(LongName, i, 1) = " " Then ' k = k + 1 ' ' to assign the First Name ' If i <> Len(LongName) Then ' PartName(k) = Mid(LongName, Myst, Myend - Myst) ' End If ' ' to Start count the letters of a new word ' Myst = Myend + 1 ' If k = 5 Then ' MsgBox "More than Five names is not allowed " ' Exit Sub ' End If ' End If ' If i = Len(LongName) Then ' k = k + 1 ' PartName(k) = Mid(LongName, Myst, Myend - Myst + 1) ' End If 'Next i 'هنا يكون استدعاء الكود 'Me.name1 = PartOfName([name1], 1) Me.da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & name1 & " تحت رقم : " & rs!N_Act_Marj Wil12.rar

سعر الصرف توقف عن العمل هذه معضلة اخرى اخي الكريم @Foksh

عاشت ايدك معلمنا @Foksh حدثت مشكلة بالبحث -- بدنا نغلبك معلم

سأوافيك بها غدا بحول الله

أين التقرير في مرفقك للتطبيق والتجربة ؟؟

شكرا استاذ على التعديل الصحيح والان كيف يستدعى الكود في التقرير علما ان name1 هو المعني Me.Da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & name1 & " تحت رقم : " & rs!N_Act_Marj

وعليكم السلام ورحمة الله وبركاته .. تم تعديل المديول ليصبح :- Option Compare Database Option Explicit Function PartOfName(InName As String, NumberOfPart As Byte) As String Dim parts() As String Dim tempName As String Dim i As Integer Dim currentIndex As Integer Dim normalizedParts() As String Dim j As Integer tempName = Trim(InName) PartOfName = "" If tempName = "" Then Exit Function tempName = Replace(tempName, " -", " - ") tempName = Replace(tempName, "- ", " - ") tempName = Replace(tempName, " ", " ") parts = Split(tempName, " - ") currentIndex = 0 ReDim normalizedParts(0 To 0) For i = 0 To UBound(parts) If Trim(parts(i)) <> "" Then normalizedParts(currentIndex) = Trim(parts(i)) If i < UBound(parts) Then ReDim Preserve normalizedParts(0 To currentIndex + 1) currentIndex = currentIndex + 1 End If End If Next i If UBound(normalizedParts) > 0 Then If NumberOfPart - 1 <= UBound(normalizedParts) Then PartOfName = Trim(normalizedParts(NumberOfPart - 1)) End If Else Dim words() As String words = Split(tempName, " ") If NumberOfPart - 1 <= UBound(words) Then PartOfName = Trim(words(NumberOfPart - 1)) End If End If End Function Function NoSpaces(InName As String) As String Dim NewName As String Dim i As Integer Dim TheStr As String Dim ThePrevStr As String InName = Trim(InName) For i = 1 To Len(InName) TheStr = Mid(InName, i, 1) If TheStr = " " And ThePrevStr = " " Then TheStr = "" If TheStr <> "" Then ThePrevStr = TheStr NewName = NewName & TheStr Next NoSpaces = NewName End Function وتم تعديل الإستعلام ليصبح :- SELECT Table1.Name, PartOfName([Name],1) AS Firstname, PartOfName([Name],2) AS Secondname, PartOfName([Name],3) AS Thirdname, PartOfName([Name],4) AS Forthname, PartOfName([Name],5) AS SubFamily, PartOfName([Name],6) AS Family, [SubFamily] & " " & [Family] AS Familyname FROM Table1 WITH OWNERACCESS OPTION; ملفك بعد التعديل :- فصل ماقبل المطة.zip

وعليكم السلام ورحمة الله وبركاته .. استخدم في حدث في الحالي الكود التالي :- If Me.NewRecord Then Me.AllowAdditions = True Me.AllowEdits = True Me.AllowDeletions = True Else Me.AllowEdits = False Me.AllowDeletions = False End If وفي حدث بعد الإضافة للنموذج الحدث التالي :- Private Sub Form_AfterInsert() Me.AllowEdits = False Me.AllowDeletions = False End Sub ملفك بعد التطبيق :- 123452025.zip

السلام عليكم أساتذي الكرام 1- ياريت مساعدة بالتعديل على الاستعلام والمتمثل في : التعديل على كود الفصل في الاسم المركب سوى احادي او ثنائي او ثلاثي او رباعي المهم يكون الفصل في الاسم المركب قبل " - " لوحده الحالي: الماء الأبيض - تبسة / الكود يفصلها " الماء " و " الأبيض " المطلوب : الماء الأبيض - تبسة / الكود يفصلها " الماء الأبيض " 2- كيف يستدعى كود الفصل في تقرير مثلا وشكرا فصل ماقبل المطة.rar

بارك الله فيكم وينكم من زمان هذا الموضوع طرحته اليوم بعد وصولي لنتيجة صحيحة مرضية بل محكمة هذا الوصول سبقه موضوع تجاوزت المشاركات فيه الــــ 100 لن اتنازل عن اكوادي التي صنعتها .. مادام العمل سليم .. لاني تعبت من التجربة والتكرار والبحث عن الطريقة السليمة ..... ولكن ستبقى هذه الأكواد التي تفضلتم بها مرجعا مهما لي ولغيري لمن اراد بناء برنامج حضور كي يستنير بها حفظكم الله من كل سوء وزادكم علما ورفعة

ممتاز جدا جدا وانا قمت بتجربة كود جلب الخطوط العربية فقط من النظام وسوف ادمج بينه وبين طريقتى لتمكين المطور او المستخدم من تحديد خطوط معينه ان اراد ذلك فى المستقبل وهذا الكود المنقح Option Compare Database Option Explicit '=== تعريف LOGFONT === Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(0 To 31) As Byte End Type Private Const ARABIC_CHARSET As Byte = 178 Private Const DEFAULT_CHARSET As Byte = 1 '=== الـ API Declarations === #If VBA7 Then Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long Private Declare PtrSafe Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" _ (ByVal hdc As LongPtr, lpLogFont As LOGFONT, ByVal lpEnumFontProc As LongPtr, _ ByVal lParam As LongPtr, ByVal dwFlags As Long) As Long #Else Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" _ (ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, _ ByVal lParam As Long, ByVal dwFlags As Long) As Long #End If Private m_FontList As Collection '=== الدالة الرئيسية === Public Sub LoadArabicFonts(cbo As Control, Optional IncludeNonArabic As Boolean = False) On Error GoTo ErrorHandler ' التحقق من صحة الـ Control If cbo Is Nothing Then Err.Raise 91, , "Control غير صالح" ' تهيئة القائمة بأمان SafeClearCombo cbo cbo.RowSourceType = "Value List" ' تحميل الخطوط Set m_FontList = New Collection If LoadSystemArabicFonts(IncludeNonArabic) Then PopulateComboBox cbo Else SafeAddItem cbo, "خطوط غير متوفرة" End If Exit Sub ErrorHandler: SafeClearCombo cbo SafeAddItem cbo, "خطأ في تحميل الخطوط" Debug.Print "LoadArabicFonts Error: " & Err.Number & " - " & Err.Description End Sub '=== وظائف مساعدة آمنة === Private Sub SafeClearCombo(cbo As Control) On Error Resume Next cbo.Clear On Error GoTo 0 End Sub Private Sub SafeAddItem(cbo As Control, itemText As String) On Error Resume Next cbo.AddItem itemText On Error GoTo 0 End Sub '=== تحميل الخطوط من النظام === Private Function LoadSystemArabicFonts(IncludeNonArabic As Boolean) As Boolean Dim hdc As LongPtr Dim lf As LOGFONT ' إعداد LOGFONT للخطوط العربية lf.lfCharSet = IIf(IncludeNonArabic, DEFAULT_CHARSET, ARABIC_CHARSET) ' الحصول على Device Context #If VBA7 Then hdc = GetDC(0) #Else hdc = GetDC(0&) #End If If hdc = 0 Then Exit Function On Error GoTo Cleanup EnumFontFamiliesEx hdc, lf, AddressOf EnumFontProc, 0, 0 Cleanup: LoadSystemArabicFonts = (m_FontList.Count > 0) #If VBA7 Then ReleaseDC 0, hdc #Else ReleaseDC 0&, hdc #End If On Error GoTo 0 End Function '=== Callback للخطوط === #If VBA7 Then Private Function EnumFontProc(lpelf As LOGFONT, ByVal lpntm As LongPtr, _ ByVal FontType As Long, ByVal lParam As LongPtr) As Long #Else Private Function EnumFontProc(lpelf As LOGFONT, ByVal lpntm As Long, _ ByVal FontType As Long, ByVal lParam As Long) As Long #End If On Error Resume Next Dim fName As String fName = StrConv(lpelf.lfFaceName, vbUnicode) fName = Left$(fName, InStr(fName, ChrW(0)) - 1) fName = Trim$(fName) ' فلتر TrueType فقط + تجنب التكرار If Len(fName) > 2 And (FontType And 4) = 4 And Not FontExists(fName) Then m_FontList.Add fName, fName ' Debug.Print "Font added: " & fName ' للاختبار End If EnumFontProc = 1 End Function '=== فحص وجود الخط === Private Function FontExists(fontName As String) As Boolean Dim f As Variant On Error Resume Next Set f = m_FontList(fontName) FontExists = (Err.Number = 0) On Error GoTo 0 End Function '=== ملء القائمة مع الترتيب === Private Sub PopulateComboBox(cbo As Control) Dim arr() As String Dim i As Long If m_FontList.Count = 0 Then Exit Sub ' تحويل Collection إلى Array ReDim arr(1 To m_FontList.Count) For i = 1 To m_FontList.Count arr(i) = m_FontList(i) Next i ' ترتيب سريع QuickSort arr, LBound(arr), UBound(arr) ' إضافة للـ ComboBox For i = LBound(arr) To UBound(arr) cbo.AddItem arr(i) Next i End Sub '=== Sort === Private Sub QuickSort(arr() As String, ByVal low As Long, ByVal high As Long) Dim pivot As String, i As Long, j As Long, temp As String If low < high Then pivot = arr((low + high) \ 2) i = low: j = high Do While StrComp(arr(i), pivot, vbTextCompare) < 0: i = i + 1: Wend While StrComp(arr(j), pivot, vbTextCompare) > 0: j = j - 1: Wend If i <= j Then temp = arr(i): arr(i) = arr(j): arr(j) = temp i = i + 1: j = j - 1 End If Loop While i <= j If low < j Then QuickSort arr, low, j If i < high Then QuickSort arr, i, high End If End Sub '=== وظيفة اختبار === Public Function GetArabicFontsCount() As Long Set m_FontList = New Collection LoadSystemArabicFonts False GetArabicFontsCount = m_FontList.Count End Function

اجدت وأفدت مع ان ما قدمه اخونا Debug Ace رائع لا يقاوم .. لوجود ميزات متقدمة الا انني يبدو سأعتمد نسختك هذه لعدة اسباب : - تحقق عرض الخطوط العربية فقط من وندوز - التعامل مع التقرير مباشرة وحفظ آخر نسخة لتصبح دائمة - جلب الخلفية مفتوح وغير مقيد كل هذه قريبة من عملي تقريبا .. مع بعض التعديلات اللازمة جزاكم الله خيرا .. جميعا واجزل لكم الثواب

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

وبذلك التعديل يصبح الكود فى النهاية بهذا الشكل '=== ÇáËæÇÈÊ ááæÑÏíÉ ÇáãÓÇÆíÉ === Private Const SHIFT_START_HOUR As Integer = 17 ' 5 ãÓÇÁ Private Const SHIFT_END_HOUR As Integer = 1 ' 1 ÕÈÇÍÇ Private Const DEFAULT_WORK_HOURS As Long = 8 Private Const DEFAULT_FREE_IN_MINS As Long = 30 Private Const DEFAULT_FREE_OUT_MINS As Long = 30 '=== 1. ÝÍÕ ãÇ ÅÐÇ ßÇä ÇáæÞÊ ÇáãÍÏÏ Öãä æÑÏíÉ ãÓÇÆíÉ === Public Function IsEveningShiftNow(Optional ByVal checkTime As Date = 0) As Boolean If checkTime = 0 Then checkTime = Time() IsEveningShiftNow = (checkTime >= TimeSerial(SHIFT_START_HOUR, 0, 0)) Or (checkTime < TimeSerial(SHIFT_END_HOUR, 0, 0)) End Function '=== 2. ÊÇÑíÎ ÇáæÑÏíÉ ÇáÍÇáíÉ === Public Function CurrentShiftDate(Optional ByVal currentTime As Date = 0) As Date If currentTime = 0 Then currentTime = Time() If IsEveningShiftNow(currentTime) Then If currentTime >= TimeSerial(SHIFT_START_HOUR, 0, 0) Then CurrentShiftDate = Date Else CurrentShiftDate = Date - 1 End If Else CurrentShiftDate = Date End If End Function '=== 3. ÞÑÇÁÉ ÅÚÏÇÏÇÊ ÇáæÑÏíÉ ãÑÉ æÇÍÏÉ === Private Function GetShiftSettings() As Variant Static cachedSettings As Variant Static lastCacheTime As Date If DateDiff("n", lastCacheTime, Now()) > 5 Then Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("SELECT fatrah2_In, hours_Work2, free2_in, free2_out FROM tblTimeCtrl WHERE 1=1") If Not rst.EOF Then cachedSettings = Array( _ Nz(rst!fatrah2_In, "17:00:00"), _ Nz(rst!hours_Work2, DEFAULT_WORK_HOURS), _ Nz(rst!free2_in, DEFAULT_FREE_IN_MINS), _ Nz(rst!free2_out, DEFAULT_FREE_OUT_MINS) _ ) Else cachedSettings = Array("17:00:00", DEFAULT_WORK_HOURS, DEFAULT_FREE_IN_MINS, DEFAULT_FREE_OUT_MINS) End If rst.Close: Set rst = Nothing lastCacheTime = Now() End If GetShiftSettings = cachedSettings End Function '=== 4. æÞÊ ÈÏÇíÉ ÇáÊÓÌíá ÇáãÓãæÍ (ÞÈá ÇáÏÎæá ÇáÑÓãí) === Public Function funFirstTimeB_In(Optional ByVal refTime As Date = 0) As Date Dim settings As Variant: settings = GetShiftSettings() Dim officialIn As Date: officialIn = TimeValue(settings(0)) Dim freeMins As Long: freeMins = CLng(settings(2)) If refTime = 0 Then refTime = Time() Dim shiftDate As Date: shiftDate = CurrentShiftDate(refTime) funFirstTimeB_In = DateAdd("n", -freeMins, shiftDate + officialIn) End Function '=== 5. æÞÊ äåÇíÉ ÇáÊÓÌíá ÇáãÓãæÍ (ÈÚÏ ÇáÇäÕÑÇÝ ÇáÑÓãí) === Public Function funLastTimeB_Out(Optional ByVal refTime As Date = 0) As Date Dim settings As Variant: settings = GetShiftSettings() Dim officialIn As Date: officialIn = TimeValue(settings(0)) Dim workHours As Long: workHours = CLng(settings(1)) Dim extraMins As Long: extraMins = CLng(settings(3)) If refTime = 0 Then refTime = Time() Dim shiftDate As Date: shiftDate = CurrentShiftDate(refTime) funLastTimeB_Out = DateAdd("n", (workHours * 60) + extraMins, shiftDate + officialIn) End Function '=== 6. æÙÇÆÝ ÅÖÇÝíÉ ááÊÍÞÞ æÇáÇÎÊÈÇÑ ãÚ ãÚÇãá æÞÊ === Public Function GetCurrentShiftInfo(Optional ByVal refTime As Date = 0) As String Dim shiftDate As Date: shiftDate = CurrentShiftDate(refTime) GetCurrentShiftInfo = "ÇáæÑÏíÉ: " & Format(shiftDate, "yyyy-mm-dd") & " | " & _ "ÇáÏÎæá ÇáãÓãæÍ: " & Format(funFirstTimeB_In(refTime), "hh:nn") & " | " & _ "ÇáÎÑæÌ ÇáãÓãæÍ: " & Format(funLastTimeB_Out(refTime), "hh:nn") End Function '=== 7. ÇÎÊÈÇÑ ÇáãäØÞ === Public Function TestShiftLogic(Optional ByVal testTime As Date = 0) As String If testTime = 0 Then testTime = Now() TestShiftLogic = "ÇáæÞÊ: " & Format(testTime, "hh:nn:ss") & " ? " & GetCurrentShiftInfo(testTime) End Function Sub TestDebugPrint() Debug.Print TestShiftLogic() Debug.Print TestShiftLogic(#11:30:00 PM#) Debug.Print TestShiftLogic(#12:30:00 AM#) End Sub