نجوم المشاركات

الإصدار الأول ( لا أعتقد أنه النهائي 😁 ) من اللعبة المطورة لعبة النباتات ضد الثعبان 2026 .. كما رأيتم في الفيديو والصور التي تم طرحها في بدايات تأسيس اللعبة ، هي تجسيد للعبة الثعبان الشهيرة ولكن بنكهة فوكشية خنفشارية .. كيفية اللعب :- 1️⃣ التحكم سيكون بمفاتيح الأسهم في لوحة مفاتيحك ، لتتحكم بحركة الثعبان في الإتجاهات الأربعة . 2️⃣ عليك ان تجمع أكبر نتيجة من اكل التفاح الأحمر . 3️⃣ هناك في ساحة اللعبة تم إضافة مساعدات وأدوات إعاقة ممتعة تتلخص بما يلي :- التفاحة الحمراء = وتعطي اللاعب 10 نقاط ، وتزيد من طول الثعبان . التفاحة الخضراء = وتعطي اللاعب 50 نقطة ، أيضاً تزيد من طول الثعبان . كيس النقود = ويعطي اللاعب 100 نقطة مكافأة 💰 . شعلة النار = تعطي اللاعب 80 نقطة ، ووظيفتها تجميد حركة الوحش في اللعبة 😈 . إكسير التجميد = يعطي اللاعب 50 نقطة ، ووظيفته تجميد حركة النبتة التي تقذف القنابل 🥶 . القنبلة الأرضية = تعطي اللاعب 30 نقطة ، ووظيفتها تفجير صخور الإعاقة التي تعيق حركة الثعبان 💥 . القلب = لا يعطي أي نقاط ، ولكنه يقوم بزيادة عدد أرواح الثعبان في اللعبة ( بحد أقصى 3 أرواح ) ❤ . البوابات السحرية = أيضاً لا تعطي نقاط ، ولكنها تقوم بنقل الثعبان من مكان إلى مكان آخر ( حسب ظهور البوابات ) 🕳 . التاج الملكي 👑 = لا يعطي أي نقاط ، ولكن عند ظهوره في المستوى الـ 20 ( آخر مستوى في اللعبة ) ، فإنه يقوم بإنهاء اللعبة وإعلان الفوز . طبعاً سيظهر في مكان عشوائي ، وعلى الثعبان أكله حتى تنتهي اللعبة . أما المعوقات ، فاكتشفوها بانفسكم 😉 :- 🔴 جميع الصور داخل النموذج هدفها عدم استخدام أي مسار خارجي للصور عند التبديل أثناء الحركة وذلك بهدف تقليل الوميض والترميش . وطبعاً الترميش والوميض مرهون بمواصفات الجهاز . وبالتأكيد الأجهزة القديمة أو البطيئة قد تلاحظ الترميش بشكل أكثر قليلاً من الأجهزة المتوسطة والسريعة . 🔴 مفتاح Esc وظيفته أيقاف اللعبة مؤقتاً ، ونفسه للإستمرار 😎 . 🔴 سهواً سقطت مني الجملة :- KillTimer 0, hTimer في حدث عند الإغلاق للنموذج Frm_Game ، ليصبح الحدث :- Private Sub Form_Close() On Error Resume Next Form_SetComposited Me, False KillTimer 0, hTimer DoCmd.Quit End Sub وفي الختام أترككم مع تجربة اللعبة مفتوحة المصدر .. فقط استخدم مفتاح الشيفت إن أردت قراءة الأكواد أولاً قبل اللعب 😁 . Plants VS Snake.zip

و عليكم السلام ورحمة الله وبركاته تفضل الملف حسب نسخة الأوفيس عندك لو قديم الملف الأول و لكن اذا أضفت كلمات جديدة يجب أن تضيفها في الصيغة ولو عندك . أوفيس حديث يمكن استخدام الملف الثاني فهو يتعرف على الكلمات تلقائيا الملف الثالث يعمل بالأكواد الحضور والغياب (2).xlsx الحضور والغياب حديث.xlsx الحضور والغياب أكواد.xlsm

تفضل لعل هذا طلبك مع ان الملف القديم كان يحدد النتائج بمجرد الضغط على زر بحث. تم استبدال أول أسماء الأصناف بكلمات حقيقية لتجربة البحث بالأسم لأن الكل كان يبدأ بحرف ص 3 _ شهر ابريل1 2026.xlsm

تطوير جديد تم رفع المرفق في الموضوع الأساسي

يبدو أني فهمت المطلوب بشكل خاطئ بعد أن اجتهدت في حل لفهمي الخاطئ وجدت أن المطلوب على خلاف فهمي 🙂 . دائرة حول الرقم_02.xlsm

السلام عليكم ورحمة الله وبركاته .. 🙂 نزولا عند رغبة شيخنا الفاضل @ابوخليل تم إضافة تحسين بسيط على دالة التفقيط المبسطة لتعميم الفائدة .. طبعا الدالة كانت تأخذ 3 أرقام من كسر العملة هكذا ( 143.487 ) وهذا ينطبق على بعض العملات كالريال العماني والبيسة العمانية بينما أن هناك الكثير من العملات تعتمد 2 رقمين لكسر العملة مثال الريال والهللة السعودية والجنيه والقرش المصري هكذا ( 123.45 ) والتعديل الذي تم إجراؤه هو إضافة معامل رابع للدالة للتحكم في هذا الاختلاف واختيار عدد أرقام كسر العملة 2 أو 3 حسب الحاجة .. بدون إطالة إليكم الدالة كاملة .. وكذلك تم إضافة ملف جاهز ليبين طريقة الاستخدام : 🙂 Option Compare Database Option Explicit Function NoToTxt(TheNo As Double, _ MyCur As String, _ MySubCur As String, _ Optional FractionDigits As Integer = 3 _ ) As String '---------------------------------- ' دالة التفقيط المحسنة ' TheNo : المبلغ ' MyCur : العملة الرئيسية ' MySubCur : جزء العملة ' FractionDigits : عدد أرقام جزء العملة 2 أو 3 '---------------------------------- ' : أمثلة على الاستخدام ' NoToTxt(15.436, "ريال عماني", "بيسة") ' NoToTxt(15.43, "ريال", "هللة", 2 ) ' NoToTxt2(15.436, "ريال", "بيسة", 3) '---------------------------------- Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As Integer Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String Dim IntegerPart As Double Dim FractionPart As Long Dim ScaleNo As Double ' عدد خانات الكسر المسموح بها ' الدالة الحالية تقرأ الجزء العشري كمجموعة من 3 أرقام، لذلك الحد الأعلى 3 If FractionDigits < 0 Then FractionDigits = 0 If FractionDigits > 3 Then FractionDigits = 3 If Abs(TheNo) > 999999999999.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "عليه مبلغ " Else ReMark = "له مبلغ " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "اربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "اربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "احدى" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "اربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== ' تجهيز الرقم حسب عدد الخانات المطلوبة بعد الفاصلة ' مثال: ' FractionDigits = 2 يجعل 15.436 تقرأ كـ 15.44 ' FractionDigits = 3 يجعل 15.436 تقرأ كـ 15.436 TheNo = Round(TheNo, FractionDigits) IntegerPart = Fix(TheNo) If FractionDigits = 0 Then FractionPart = 0 Else ScaleNo = 10 ^ FractionDigits FractionPart = CLng(Round((TheNo - IntegerPart) * ScaleNo, 0)) End If ' معالجة حالة التقريب التي قد ترفع الجزء العشري إلى 100 أو 1000 If FractionDigits > 0 Then If FractionPart >= ScaleNo Then IntegerPart = IntegerPart + 1 FractionPart = 0 End If End If ' الجزء الصحيح 12 رقم + الجزء العشري دائمًا 3 أرقام داخليًا ' عند اختيار خانتين مثلًا 44 يتم تخزينها كـ 044 حتى تُقرأ أربعون وأربعة GetNo = Format(IntegerPart, "000000000000") & "." & Format(FractionPart, "000") i = 0 '=============== Do While i < 16 My100 = "" My10 = "" My1 = "" My11 = "" My12 = "" GetTxt = "" If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = Mid$(GetNo, i + 2, 3) End If If Val(Mid$(Myno, 1, 3)) > 0 Then RdNo = Val(Mid$(Myno, 1, 1)) My100 = MyArry1(RdNo) RdNo = Val(Mid$(Myno, 3, 1)) My1 = MyArry3(RdNo) RdNo = Val(Mid$(Myno, 2, 1)) My10 = MyArry2(RdNo) If Val(Mid$(Myno, 2, 2)) = 11 Then My11 = "احدى عشر" If Val(Mid$(Myno, 2, 2)) = 12 Then My12 = "اثني عشر" If Val(Mid$(Myno, 2, 2)) = 10 Then My10 = "عشرة" If Val(Mid$(Myno, 1, 1)) > 0 And Val(Mid$(Myno, 2, 2)) > 0 Then My100 = My100 & MyAnd End If If Val(Mid$(Myno, 3, 1)) > 0 And Val(Mid$(Myno, 2, 1)) > 1 Then My1 = My1 & MyAnd End If GetTxt = My100 & My1 & My10 If Val(Mid$(Myno, 3, 1)) = 1 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 & My11 If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My11 End If If Val(Mid$(Myno, 3, 1)) = 2 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 & My12 If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My12 End If If i = 0 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then Mybillion = GetTxt & " مليار" Else Mybillion = GetTxt & " مليارات" If Val(Mid$(Myno, 1, 3)) = 1 Then Mybillion = " مليار" If Val(Mid$(Myno, 1, 3)) = 2 Then Mybillion = " ملياران" End If End If If i = 3 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then MyMillion = GetTxt & " مليون" Else MyMillion = GetTxt & " ملايين" If Val(Mid$(Myno, 1, 3)) = 1 Then MyMillion = " مليون" If Val(Mid$(Myno, 1, 3)) = 2 Then MyMillion = " مليونان" End If End If If i = 6 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then MyThou = GetTxt & " الف" Else MyThou = GetTxt & " الاف" If Val(Mid$(Myno, 1, 3)) = 1 Then MyThou = " الف" If Val(Mid$(Myno, 1, 3)) = 2 Then MyThou = " الفان" End If End If If i = 9 And GetTxt <> "" Then MyHun = GetTxt If i = 12 And GetTxt <> "" Then If FractionDigits > 0 Then MyFraction = GetTxt End If End If End If i = i + 3 Loop '============================ If Mybillion <> "" Then If MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then Mybillion = Mybillion & MyAnd End If End If If MyMillion <> "" Then If MyThou <> "" Or MyHun <> "" Then MyMillion = MyMillion & MyAnd End If End If If MyThou <> "" Then If MyHun <> "" Then MyThou = MyThou & MyAnd End If End If If MyFraction <> "" Then If Mybillion <> "" Or MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then NoToTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & MyAnd & MyFraction & " " & MySubCur & " فقط" Else NoToTxt = ReMark & MyFraction & " " & MySubCur & " فقط" End If Else NoToTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & " فقط" End If End Function NoToTxt.accdb

السلام عليكم كما في العنوان حسابات جارية للأموال الواردة والمنصرف لشركة محددة وفروعها قيود للفروع وللموظفين تحويلات مفتوحة بين هذه القيود حساب الواردات لكل فرع حساب المصاريف لكل فرع تقرير تفصيلي حسب كل قيد رواتب الموظفين .. حسب الموظف الواحد وفرعه او حسب موظفي فرع او جميع موظفي الشركة ... فقط بضغطة زر برنامج عفريت صغير يقدم خدمة عظيمة اتمنى ان تجدوا الفائدة .. الفائدة العملية باستخدامه .. او الاستفادة من فكرة التصميم وبناء الأساسات تطوير البرنامج : 1- تقسيم قاعدة البيانات 2- اضافة شاشة دخول ومستخدمين ( كلمة المرور للجميع = 1) 3- تحسينات على بعض النماذج مثل نموذج الموظفين 4- اضافة دالة الاستااذ موسى لتفقيط المبالغ واشياء اخرى لا تحضرني البرنامج قابل لاي تطوير جديد التطوير الجديد غالبا سيتم على الواجهات .. مما يعني ان بياناتك لو استخدمت البرنامج (النسخة هذه الأخيرة) ستبقى بياناتك آمنة ولن يجري عليها اي تغيير تطوير 3 ضبط نماذج الادخال بتصميم جديد محكم وزيادة حقول للبيانات اللازمة اضافة تقارير خاصة لعرض الاسماء وتقارير تصفية للحسابات ولمسات اخرى تطوير 5 اقتباس من واجهات الاستاذ موسى مع بعض تصرف عمل نظام صلاحيات خفيف ومختصر توسع من اجل التطوير مستقبلا الادمن كلمة المرور =78 البقية كلمة المرور =1 طوير 7 ,, شبه نهائي اعتقد انني وصلت الى استيفاء مجمل المتطلبات في برنامج حسابات مالية جارية .. الاضافات : - اضافة بيانات المنشأة - امكانية رفع شعار خاص بالمنشأة - اسيفاء واعداد جميع التقارير والكشوف الاجمالية والتفصيلية - اضافة خدمة اخذ نسخة احتياطية ... ( حفظ في مجلد البرنامج أو ارسال الى USB ) لمسات اخرى تجدونها في العمل المرفق كلمات المرور : admin = 78 الآخرين = 1 اتمنى تجدو المتعة والفائدة ولا تنسوني من دعواتكم الطيبات تطوير بتاريخ 1/5/2026 تحسينات على التقارير اضافة نظام الحجب كبديل للحذف اشياء اخرى تجدونها officena_EasyAcc.rar

ولكن هذا ليس من تعديلي انا ، هذا الـ api للنواة 64بت

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

أخي الكريم الملف عندك من اسبوعين و لم تكتشف أن البحث لا يعمل. كل شيء تمام بالملف و البحث بالاسم يعمل و مرفق صورة

https://www.officena.net/ib/topic/139246-عمل-مصادقة-بالأكسيل-من-بيانات-sap/#findComment-774215 أهلا بك أخي : الذكاء الاصطناعي جعل المبرمجين عاجزين على كتابة كود بالكامل ولكن أصبح شغلهم هو التعديل على الكود فقط الأكواد الطويلة ( مثل الكود الذي طلبت تعديله ) يحتاج وقت لكتابة وتصحيح الأخطاء أما الذكاء الاصطناعي فيكتبه في 1 دقيقة فقط تقريبا (وربما يستغرق أكثر من هذا الوقت إذا كان الكود طويلا ) هذا القسم ليس مخصصا لشرح الذكاء الاصطناعي ادخل على اليوتيوب وستجد مئات المقاطع تشرح ذلك ولكن انصحك أن تركز على واحد (فقط فقط فقط فقط فقط) من نماذج الذكاء الاصطناعي لأنك مبتدئ فإذا عرفت استخدام هذا النموذج فيمكنك بعد ذلك التنقل بين النماذج المختلفة تقبل تحياتي

احسنت وابدعت يا بروف كالعاده

جرب الملف و تأكد أن تعمل توسيط للأرقام في الخلية الدوائر تعمل تلقائيا بمجرد ادخال الرقم و تختفي تلقائيا لو تم التعديل بداية من 50 دائرة حول الرقم.xlsm

السلام عليكم ورحمة الله وبركاته 🙂🖐 يقول المثل : أن تأتي متأخرا خير من أن لا تأتي 😅✌ بعد جهد جهيد إنتهيت من تصميم نظام تسجيل دخول + نظام صلاحيات متطور كلما أخطو فيه خطوة أجد أنه ناقص وتطلع أفكار جديدة .. 😅👊 لذلك قلت سأنزلها كما هي الآن .. حاولت تبسيطه للمستخدم والمستفيدين منه لاحقا قدر المستطاع .. وسأبدأ بواجهة تسجيل الدخول المتواضعة : المزايا : حفظ بيانات دخول المستخدم (اختياري) الدخول مباشرة بمجرد كتابة كلمة المرور بشكل صحيح (تسريع عملية الدخول) ملاحظة : جميع كلمات المرور في البرنامج : 123 ثانيا الواجهة الرئيسية : يتم تطبيق الصلاحيات للمستخدم بمجرد تسجيل الدخول .. ثالثا : إدارة المستخدمين هنا يتم إدارة جميع ما يتعلق بمستخدمي البرنامج ( إضافة ، تعديل ، حذف ، تعيين الصلاحيات ) رابعا : إدارة مجموعات العمل والصلاحيات لكل مجموعة هنا يتم ضبط الصفحات المسموح لكل مجموعة دخولها والصلاحيات الخاصة بكل صفحة .. ومثل ماهو واضح يمكن إضافة النماذج أو إزالتها كما يحلو لك وبعد ضبط مجموعات العمل يتم تعيين كل مستخدم للمجموعة الخاصة به ، ويمكن عمل مجموعة خاصة لشخص واحد فالخيارات غير محدودة .. 🙂 الآن يمكنك الخروج من البرنامج ثم تجربة تسجيل الدخول باسم المستخدمين المسجيلين في البرنامج للاستمتاع بتجربة الصلاحيات الممنوحة لكل مستخدم 😊 وبعد الدخول للصفحات يتم تطبيق الصلحيات الخاصة بالنموذج أيضا .. وبقية الصلاحيات ستظهر حسب الزر الذي يتم الضغط عليه مزايا إضافية موجودة في البرنامج .. ولها علاقة بالأمان أيضا .. نظام النسخ الاحتياطي وله إعدادات خاصة به (نسخ احتياطي يدوي أو تلقائي ) وهو موجود في صفحة إعدادات البرنامج : ولكل مستخدم مجموعة خيارات يمكنه التحكم بها مثل ( تغيير كلمة المرور ، التشغيل عند إقلاع الجهاز ، إنشاء اختصار في سطح المكتب ، حفظ بيانات التسجيل لتسريع الدخول للبرنامج) هذه هي أهم الميزات التي يحتويها البرنامج 🙂 ولفتح البرنامج في وضع التصميم ، حتى هذي سهلة للمبرمج 😅🖐 في صفحة تسجيل الدخول وكذلك الصفحة الرئيسية يوجد هذا الزر الخاص بالمبرمج >> بعد الضغط عليه >> أدخل كلمة المرور : 123 ويمكنك تغييرها من الكود الخاص بالزر .. بتظهر لك هذي النافذة الخاصة بالمبرمج فقط : وأهم ما فيها : (1) عرض الشريط العلوي ونافذة الأكسس >> بعد تفعيله تحفظ وتشغل الماكرو وبتنفتح عندك واجهة الأكسس >> أعد تشغيل البرنامج من جديد للحصول على جميع الميزات. (2) اسم نموذج البداية >> وهو أو نموذج بيشتغل معاك في البرنامج >> وهذا يسهل على المبرمج تطبيق النظام على أي برنامج آخر 🙂 (3) اسم البرنامج (واللي ييظهر في الشريط العلوي للأكسس) : (4) رقم الإصدار (نسخة البرنامج) وتاريخها >> ويمكن الاعتماد عليها لتحديث البرنامج لاحقا .. (5) إدارة نماذج الصلاحيات >> وهي النماذج اللي ستسمح بإعطاء صلاحيات لدخولها للبرنامج .. وكذلك تعطي كل نموذج اسم صديق للمستخدم وسيتم استخدام المسمى الحقيقي للنموذج داخليا .. وهكذا أكون شرحت لكم أهم المميزات ويتبقى نقطة مهمة وهي : يمكن للمبرمج الآن الاستفادة من هذا الملف فهو قاعدة جاهزة لإنطلاق في تصميم برنامجك الخاص .. جميع الأكواد الخاصة بالصلاحيات ستجدها في الموديول التالي : وأهم ما ستحتاج معرفته في كيفية تطبيق الصلاحيات ذكرته في الملاحظات المكتوبة أول الموديول : ' (1) : لتطبيق صلاحية فتح النماذج وصلاحيات الإضافة والتعديل والحذف تضع الأسطر التالية أول الأكواد في حدث فتح النموذج '------------------------------------------------------------------------------- 'Private Sub Form_Open(Cancel As Integer) ' ' فحص صلاحة دخول النموذج ' Cancel = Not Permission_OpenForm(Me.Name, True) ' ' تطبيق صلاحيات : الإضافة / التعديل / الحذف ' Apply_Addition_Edits_Delete_Permissions (Me.Name) 'End Sub '------------------------------------------------------------------------------- ' (2) : لتطبيق صلاحيات الطباعة والاستيراد والتصدير داخل نموذج معين تكتب هذه الأسطر لمعرفة وجود الصلاحة من عدمها ' : وكل سطر من هذه الصلاحيات يرجع لك النتيجة كما يلي ' True : مسموح ' False : ممنوع '------------------------------------------------------------------------------- ' 1- فحص صلاحية الطباعة (True/False) ' Permission_Print(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 2- فحص صلاحية الاستيراد (True/False) ' Permission_Import(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 3- فحص صلاحية التصدير (True/False) ' Permission_Export(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها '------------------------------------------------------------------------------- والنماذج الموجودة في البرنامج مع أزرارها تم تطبيق الأكواد عليها بشكل عملي << راجعها وأدرسها لمعرفة كيفية عملها .. وهي سهلة يسيرة بفضل الله 🙂 وهذا مثال عملي لتطبيق الصلاحية على زر الطباعة (فتح التقرير) مثلا : وهكذا بقية الصلاحيات (اطلع على بقية الموديول) تم تحويلها لأسطر قليلة بسيطة للاستفادة منها بكل يسر .. 🙂 وأخيرا تحميل البرنامج :: Moosak ‏‏Login System with permissions 1.0.zip :: وآخر دعوانا أن الحمد لله رب العالمين ::

طريقة حفظ الملف بعد وضع الكود في الملف قم باغلاق الملف ستاتى رسالة كما بالصورة اخت اختر حفظ ستاتى رسالة اخرى كما بالصورة اختر لا ستفتح واجهة كما بالصورة قم بالاختيار حسب الصف المحدد ثم حفظ casse 2026 .xlsb

أعتقد الحل رياضياتيا صحيح، فقط المشكلة أني لم احترز لوجود خلايا فاضية بناء على المثال في المرفق السابق. لاحظ أجوبتك (مبهمة) غير صريحة!! يجب تحديد الخطأ بشكل واضح. محاولة أخرى بدون تغيير في النتائج فقط تم تبديل نوع المتغيرات احترازا عند وجود خلايا فاضية في العطل/الإجازات. Function Between(inDate As Long, Date1 As Long, Date2 As Long) As Boolean Between = inDate >= Date1 And inDate <= Date2 End Function Function getHolidays(Holiday1 As Long, Holiday2 As Long, _ Workday1 As Long, Workday2 As Long) As Integer Dim Date1 As Long, Date2 As Long 'On Error Resume Next 'Min date is 31/12/1899 If Holiday1 <= 0 Or Holiday2 <= 0 Then Exit Function If Between(Holiday1, Workday1, Workday2) Or _ Between(Holiday2, Workday1, Workday2) Or _ Between(Workday1, Holiday1, Holiday2) Or _ Between(Workday2, Holiday1, Holiday2) Then Date1 = IIf(Holiday1 >= Workday1, Holiday1, Workday1) Date2 = IIf(Holiday2 <= Workday2, Holiday2, Workday2) getHolidays = Date2 - Date1 + 1 End If End Function حساب أيام العمل خلال_04.xlsm

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

الصراحة معظم دوال الإكسل المستجدة أجهلها، فعملت لك دالة بالـ vba عملتها وأنا شبعان وأفكر في القيلولة، فربما تحتوي على أخطاء. Function Between(inDate As Date, Date1 As Date, Date2 As Date) As Boolean Between = inDate >= Date1 And inDate <= Date2 End Function Function getHolidays(Holiday1 As Date, Holiday2 As Date, Workday1 As Date, Workday2 As Date) As Integer Dim Date1 As Date, Date2 As Date If Between(Holiday1, Workday1, Workday2) Or _ Between(Holiday2, Workday1, Workday2) Or _ Between(Workday1, Holiday1, Holiday2) Or _ Between(Workday2, Holiday1, Holiday2) Then Date1 = IIf(Holiday1 >= Workday1, Holiday1, Workday1) Date2 = IIf(Holiday2 <= Workday2, Holiday2, Workday2) getHolidays = Date2 - Date1 + 1 End If End Function حساب أيام العمل خلال_03.xlsm

السلام عليكم جرب التعديل التالي طلب تعديل كود.xlsm

وعليكم السلام ورحمة الله وبركاته حسب فهمي لطلبك اليك المطلوب طباعة مع ترقيم الصفحة.xlsm

طيب وقبل طرح الحل ، هل النتيجة في الصورة التالية صحيحة ؟ لاحظ أنني قمت بتعديل تاريخ العطل الصيفية والشتوية من 2022 لتصبح 2025

و عليكم السلام ورحمة الله وبركاته استخدم الصيغة =IFERROR(VLOOKUP(G2;بيانات!$S:$T;2;0);"") نقل رقم الهوية_بناء على رقم الطالب (1).xlsx

هههههههه ، يا عيني عليك ، اكتشفتها بنفسك .. جرب التعديل الأخير على أكثر من احتمال :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape, c As Range Dim r As Long, i As Long, n As Long Dim usedRows As Collection Dim dayCount As Long, perDay As Long, extra As Long Dim rr As Variant, lastCol As Long Dim hasLesson As Boolean Dim lessonCount As Long Dim circlesThisDay As Long If x <= 0 Then Exit Sub Set usedRows = New Collection lessonCount = 0 For r = startRow To endRow hasLesson = False For i = 3 To 10 If Cells(r, i).Value <> "" Then hasLesson = True lessonCount = lessonCount + 1 End If Next i If hasLesson Then usedRows.Add r Next r dayCount = usedRows.Count If dayCount = 0 Then Exit Sub n = 0 If x = lessonCount Then For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r ElseIf x > lessonCount Then Do While n < x For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r Loop Else perDay = x \ dayCount extra = x Mod dayCount If x > 10 And x < lessonCount Then extra = extra + 1 For Each rr In usedRows circlesThisDay = perDay If extra > 0 Then circlesThisDay = circlesThisDay + 1 extra = extra - 1 End If lastCol = 0 For i = 10 To 3 Step -1 If Cells(rr, i).Value <> "" Then lastCol = i Exit For End If Next i For i = lastCol To 3 Step -1 If Cells(rr, i).Value <> "" And circlesThisDay > 0 Then Set c = Cells(rr, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 circlesThisDay = circlesThisDay - 1 n = n + 1 If n = x Then Exit Sub End If Next i Next rr End If End Sub

وعليكم السلام ورحمة الله وبركاته .. جري استخراج القيم من الخليتين كنص . في أي خلية تريدها استخدم المعادلة التالية :- =TEXT(C3,"yyyy/mm/dd") & " " & TEXT(B3,"yyyy/mm/dd")

السلام عليكم ورحمة الله وبركاته بعد التجربة على اكثر من جهاز ظهرت بعض المشاكل منها بطئ الجهاز وزر طباعة شهادات اخر العام لايعمل وبحمد الله وبفضله تم حل جميع المشاكل . ووجب على التنبيه وادعو الله ان يكون هذا العمل من باب علم ينتفع به وهذا هو التعديل الجديد بنفس الباسورد والطريقة السابقة في بداية المشاركة offcinal_1_3am.xlsm

السادة الزملاء : مرفق دالة التفقيط بدون اكواد كل ما عليك ان تدرج الشيت المرفق فى اى ملف اكسيل تريد تفعيل دالة التفقيط بدون اكواد ولو نسخة الاكسيل 2021 فيما فوق يتم استخدام دالة مخصصة اسمها tafkeet Tafqeet_Dynamic_System (1).xlsx

السلام عليكم بعد اذن استاذنا ابو مروان اليك تعديل زر الترحيل باستخدام المصفوفات Sub AddEmployee() Dim ws1 As Worksheet, ws2 As Worksheet Dim nextRow As Long, i As Long Dim srcRange As Variant Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("Sheet2") If ws1.Range("I9").Value = "" Then MsgBox "يرجى إدخال اسم الموظف!", vbExclamation, "تنبيه" Exit Sub End If nextRow = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row + 1 srcRange = Array("I5", "I7", "I9", "I11", "I13", "L11", "L13", "I15", "L15", _ "L5", "L7", "L9", "I19", "L19", "I21", "L21", "I23", "L23", _ "I25", "L25", "I28", "L28", "L30", "I33", "L33", "I35", "L35", _ "I37", "I40", "L40", "I44", "L44", "I46", "L46", "I48", "L48", _ "I50", "L50", "I52", "L52", "L55") For i = LBound(srcRange) To UBound(srcRange) ws2.Cells(nextRow, i + 1).Value = ws1.Range(srcRange(i)).Value Next i MsgBox "تمت إضافة الموظف بنجاح!", vbInformation, "نجاح" End Sub بسم الله.xlsm

تفضل جرب الملف مصادقة 1.xlsx