كل الانشطه

جزاك الله خيرا .. وكتبها في موازين أعمالك

السلام عليكم ورحمة الله وبركاته .. 🙂 بناءا على رغبة شيخنا الفاضل @ابوخليل تم إضافة تحسين بسيط على دالة التفقيط المبسطة لتعميم الفائدة .. طبعا الدالة كانت تأخذ 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

أين تعليم المشاركة ك Solution

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

الف شكر اخى الغالى تمام تسلم جزاك الله كل خير تقبل تحياتى

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

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

السلام عليكم ورحمة الله وبركاته مساعدة / دالة لحساب الكلمات المكررة بالخلية بحيث إذا تغيرت الكلمات تتغير النتيجة ملف مرفق وجزاكم الله كل خير ، تحياتي الى كل أعضاء الموقع الحضور والغياب.xlsx

شكراً لك استاذي جعفر على لفت الإنتباه لهذه النقطة ، سآخذها بعين الإعتبار مرجعاً لي 😇 . أعتقد بعد تجربتي على أكثر من جهاز لم يظهر لي هذا الخطأ بعد إيقاف المؤقت قبل اغلاق القاعدة ، كما ذكرت في النقطة . KillTimer 0, hTimer ولكن لا يمنع أخذ الإحتياط لكافة الإحتمالات 😇 .

قد يكون كذلك ، كانت عندي النقطة المفصلية أنك جعلت rgb As LongPtr في حالة VBA7 ، وهذا غير صحيح لأن اللون ليس Pointer 🤔 . وباعتقادي أن الصحيح هو بقاء rgb As Long دائماً ، بينما الـ Hwnd هو الذي يتغير بين Long و LongPtr . لم أجرب تعديلك لتأكيد وتصويب معلومتي ، فعذراً منكم أستاذي جعفر 😇 .

نعم ، ولكنه يعتمد api النواة :

السلام عليكم المعذرة لم اقرأ التفاصيل وجربت البرنامج على حاسبتي: اكسس 32بت حصلت على هذا الخطأ: . فاستغربت انه دخل في كود 64بت !! . فقمت بتعديل جميع VBA7 في البرنامج الى VBA7 And Win64 ، فاشتغل البرنامج : #If VBA7 And Win64 Then . وعند اغلاق البرنامج ، قفل الاكسس ما كان يختفي : . فعملت التغيير على جميع ، وانحلت هذه القضية كذلك: بدلا عن DoCmd.close الى Application.close . في بعض الاحيان كان الثعبان يعمل وميض ، ولكنه في معظم الوقت كان يشتغل تمام. ومرفق النسخة بعد هذه التعديلات. Plants VS Snake.zip

أليس هذا ما يمثل اللون المختار ؟؟ فكيف نحدده على انه LongPtr 🤔 !! مقصدي أن :- * المتغير rgb يظل Long لأنه مجرد قيمة لون ( 32‑بت ) . * المتغير Hwnd يجب أن يكون LongPtr في بيئة 64 لأنه مؤشر . * يجب أن يكون هناك تطابق بين تعريف الـ API وتعريف الدالة . هذا على حد علمي 😇 ، والله أعلم .

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

اولا شكرا لردك ثانيا يتم الاستخدام اليوم لانه اول الشهر ثالثا لا يتم البحث الا اذا كتب اسم الصنف كامل لكن لو دخلت الى شيت المخزن يتم البحث من اول حرف

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

الطريقة الاخرى هي ، اضافة PtrSafe في السطر الثالث فقط ، وبدون تغيير الدالة DialogColor ، هكذا : '#If VBA7 Then ' Private Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal Hwnd As Long, rgb As LongPtr) '#Else Private Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal Hwnd As Long, rgb As Long) '#End If Function DialogColor(rgb As Long) As Long Call ChooseColor(Application.hWndAccessApp, rgb) DialogColor = rgb End Function 1643.1.FileDialog.accdb

البحث بالاسم لا يعمل ياريت يكون البحث باول حرف كما فى الشيت الاول المخزن

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

شكر وتقدير واحترام من القلب

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

أخي الكريم. محرر الأكواد مغلق برقم سري

تمام بارك الله فيك ...هذا هو الفضل وزياده ........ زادك الله علما

الإصدار الأول ( لا أعتقد أنه النهائي 😁 ) من اللعبة المطورة لعبة النباتات ضد الثعبان 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

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