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

وعليكم السلام ورحمة الله تعالى وبركاته Function NumtoTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim txtArr1(0 To 9) As String, txtArr2(0 To 9) As String, txtArr3(0 To 9) As String Dim Myno As String, GetNo As String, RdNo As String, My100 As String, I As Integer Dim My10 As String, My1 As String, My11 As String, My12 As String, GetTxt As String Dim MyAnd As String, Mybillion As String, MyMillion As String, MyThou As String Dim MyHun As String, MyFraction As String, ReMark As String If TheNo > 999999999999.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1: ReMark = "يتبقى لكم " Else ReMark = "" If TheNo = 0 Then NumtoTxt = "صفر": Exit Function MyAnd = " و" txtArr1(0) = "": txtArr1(1) = "مائة": txtArr1(2) = "مائتان": txtArr1(3) = "ثلاثمائة": txtArr1(4) = "أربعمائة" txtArr1(5) = "خمسمائة": txtArr1(6) = "ستمائة": txtArr1(7) = "سبعمائة": txtArr1(8) = "ثمانمائة": txtArr1(9) = "تسعمائة" txtArr2(0) = "": txtArr2(1) = "عشر": txtArr2(2) = "عشرون": txtArr2(3) = "ثلاثون": txtArr2(4) = "أربعون" txtArr2(5) = "خمسون": txtArr2(6) = "ستون": txtArr2(7) = "سبعون": txtArr2(8) = "ثمانون": txtArr2(9) = "تسعون" txtArr3(0) = "": txtArr3(1) = "واحد": txtArr3(2) = "اثنان": txtArr3(3) = "ثلاثة": txtArr3(4) = "أربعة" txtArr3(5) = "خمسة": txtArr3(6) = "ستة": txtArr3(7) = "سبعة": txtArr3(8) = "ثمانية": txtArr3(9) = "تسعة" GetNo = Format(TheNo, "000000000000.000") I = 0 Do While I < 15 If I < 12 Then Myno = Mid$(GetNo, I + 1, 3) ElseIf I = 12 Then Myno = Mid$(GetNo, I + 2, 3) End If If Val(Myno) > 0 Then RdNo = Mid$(Myno, 1, 1): My100 = txtArr1(Val(RdNo)) RdNo = Mid$(Myno, 3, 1): My1 = txtArr3(Val(RdNo)) RdNo = Mid$(Myno, 2, 1): My10 = txtArr2(Val(RdNo)) If Mid$(Myno, 2, 2) = "11" Then My11 = "إحدى عشر" If Mid$(Myno, 2, 2) = "12" Then My12 = "اثنا عشر" If 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 If Val(Mid$(Myno, 3, 1)) > 0 And Val(Mid$(Myno, 2, 1)) > 1 Then My1 = My1 + MyAnd 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(Myno) > 10 Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If Val(Myno) = 1 Then Mybillion = "مليار" If Val(Myno) = 2 Then Mybillion = "ملياران" End If If I = 3 And GetTxt <> "" Then If Val(Myno) > 10 Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If Val(Myno) = 1 Then MyMillion = "مليون" If Val(Myno) = 2 Then MyMillion = "مليونان" End If If I = 6 And GetTxt <> "" Then If Val(Myno) > 10 Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If Val(Mid$(Myno, 3, 1)) = 1 Then MyThou = "ألف" If Val(Mid$(Myno, 3, 1)) = 2 Then MyThou = "ألفان" End If If I = 9 And GetTxt <> "" Then MyHun = GetTxt If I = 12 And GetTxt <> "" Then MyFraction = GetTxt End If I = I + 3 Loop If Mybillion <> "" Then If MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then Mybillion = Mybillion + MyAnd If MyMillion <> "" Then If MyThou <> "" Or MyHun <> "" Then MyMillion = MyMillion + MyAnd If MyThou <> "" Then If MyHun <> "" Then MyThou = MyThou + MyAnd If MyFraction <> "" Then If Mybillion <> "" Or MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then NumtoTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & MyAnd & MyFraction & " " & MySubCur Else NumtoTxt = ReMark & MyFraction & " " & MySubCur End If Else NumtoTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur End If End Function تعديل المبلغ - فلس V2.xlsm

طيب اليكم المرفق الاخيـــــــــــــــــــر المميزات : الاعتماد الكامل على الرقم القومى دوال منفصلة لسهولة استدعائها فى استعلام من خلال الرقم القومى يتم استخراج الجنس/النوع استخراج مكان الميلاد استخراج تاريخ الميلاد حساب العمر بالسنوات حساب العمر بالأشهر حساب العمر بالأيام بناء على حقل تاريخ الميلاد المستخرج من الرقم القومى يتم عمل التالى حساب تاريخ التقاعد حساب سن التقاعد السنوات المتبقيه للتقاعد الاشهر المتبقيه للتقاعد الايام المتبقيه للتقاعد افتح الاستعلام فى القاعده والذى يحمل الاسم : qryAllInfoFromNationalID المرونة المطلقه فقط عند نقل الوحدات النمطية الى اى قاعدة بيانات عمل استعلام وفقط تغير اسم الحقل الخاص بالرقم القومى تبعا للمسمى الموجود فى الجدول الخاص بكم والملون هنا باللون الاحمر BirthDateFromNationalID: GetBirthDateFromNationalID([Emp_NationalID]) وباقى حقول الاستعلام جميعا تعتمد على هذا الحقل لذلك يتم نقلها كما هى ولكن ولكن ولكن لا تغير اسم الحقل : BirthDateFromNationalID لان هذا الاسم تعتمد باقى وكل الحقول الاخرى عليه اعتقد بهذا المرفق يكون الموضوع قتل بحثا وتم عمل كل ما يمكن فيه ويمكن وبكل سهولة ومرونة الان استخدام الحقول المناسبه حسب الحاجه داخل التقارير او النماذج بكل بساطه تم اضافة : نموذج : frmAllInfoFromNationalID تقريــر : rptAllInfoFromNationalID مصدر بيانات كل منهما الاستعلام : qryAllInfoFromNationalID اما النموذج : frmEmployees مصدر بياناته هو الجدول مباشرة الان القاعده كاملة و متكاملة مع تحقيق أقصى درجات المرونه المطلقة والحصول على كل البيانات الممكنه من خلال الرقم القومى مباشره سن التقاعد (8).accdb

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

اريد مايكرو لفتح التعديل وفتح الحذف علي النموذج عندى نموذج مانع عنه التعديل والحذف بس عايز لما اضغط علي كنترول + حرف t يفعل خاصيه التعديل في النوذج ولو ضغط علي كنترول + حرف d افعل خاصيه الحذف

وهذه مشاركة بطريقة أخرى ، مشاركةً مع معلمي الجليل و والدنا العزيز الأستاذ @ابوخليل .. فكرتين ، الأولى هي بجعل الزر يفتح التقرير بشرطين = DoCmd.OpenReport "qrbook", acViewPreview, , , , Me.fsldrase.Column(1) & ";" & Me.drase.Column(1) وأن نجعل الحدث عند التحميل للتقرير = Dim args As Variant If Not IsNull(Me.OpenArgs) Then args = Split(Me.OpenArgs, ";") Me.Tx_Fasl = args(0) Me.Tx_Yer = args(1) End If والفكرة الثانية كما أشار أستاذي في مشاركته تماماً .. ومرفق زرين كل واحد منهما بطريقة نموذج بحث شامل 1.accdb

وعليكم السلام ورحمة الله تعالى وبركاته.. تقدر تستخدام حدث "On Key Down" في النموذج للتحقق مما إذا كان المستخدم قد ضغط على Ctrl + T أو Ctrl + D ثم تغيير خصائص التعديل والحذف بناءً على ذلك . بس طبعاً لازم تتأكد أن خاصية Key Preview في النموذج = Yes 😅 وإلا فلن نستفيد من الكود التالي :- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyT And (Shift And acCtrlMask) <> 0 Then Me.AllowEdits = True MsgBox "تم تفعيل التعديل", vbInformation End If If KeyCode = vbKeyD And (Shift And acCtrlMask) <> 0 Then Me.AllowDeletions = True MsgBox "تم تفعيل الحذف", vbInformation End If End Sub جرب النتيجة النهائية وأخبرنا بها 😇

جزاك الله عنا خيرا كثيرا جدا ممنون تمام 100 % هو المطلوب

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

بسم الله الرحمن الرحيم أحبتي في الله أعضاء ومشرفي وزوار منتدى أوفيسنا الكرام، السلام عليكم ورحمة الله وبركاته، ترددت كثيرا قبل عرض هذا الاقتراح؛ نظرا لكثرة المثبطين والمحبطين الذين يحبون أن يأخذوا ولا يعطوا. ولكن توكلت على الله وقررت عرضه ليكون شاهدا علينا جميعا فيما بعد. إن ما نقدمه في هذا المنتدى من تبادل للخبرات والمعرفة هو عمل عظيم، لا يُقصد به إلا ابتغاء مرضاة الله وتطوير حياة الإنسان العربي باستخدام التكنولوجيا، وتنفيذا لقول الله تعالى: "وَتَعَاوَنُوا عَلَى الْبِرِّ وَالتَّقْوَىٰ وَلَا تَعَاوَنُوا عَلَى الْإِثْمِ وَالْعُدْوَانِ" (سورة المائدة: 2). كما أن النبي صلى الله عليه وسلم قال: "من نفس عن مؤمن كربة من كرب الدنيا نفس الله عنه كربة من كرب يوم القيامة، ومن يسر على معسر يسر الله عليه في الدنيا والآخرة، ومن ستر مسلمًا ستره الله في الدنيا والآخرة، والله في عون العبد ما كان العبد في عون أخيه" (رواه مسلم). وفي ظل هذه القيم النبيلة، ينبغي علينا أن ندرك أن بعضنا قد يعيش في ظروف مادية أفضل من أخيه حتى وإن رآها صعبة. ودعمه لمن يساعده في الوصول لحل مشكلته ليس فقط تضامنًا أو تبادلًا للمعرفة، ولكنه يكون أيضًا وسيلة عظيمة لزيادة البركة في الرزق للجميع. قال تعالى: "هَلْ جَزَاءُ الْإِحْسَانِ إِلَّا الْإِحْسَانُ" (سورة الرحمن: 60). ومن ناحية أخرى، لا يخفى علينا أن البعض قد اختار الابتعاد عن هذا الصرح لأنه لم يجد فيه ما يعين أسرته على أمور حياتها، بينما اتجه إلى بيع علمه لمن يُقدِّر هذا الجهد. وربما استغل آخرون ما قدمناه هنا في المنتدى مجانًا لوجه الله في تحقيق استفادة مادية دون أن يُراعوا حقوق من بذلوا هذا العلم. لذا، أعتقد أن الوقت قد حان لتعود الطيور المهاجرة إلى هذا المنتدى العزيز على قلوبنا جميعا، وأن نُعيد بناءه ليكون مصدرًا للعلم والنفع للجميع، بحيث نحافظ على قيمة العطاء دون أن يُضيع أحدنا حق الآخر. قال النبي صلى الله عليه وسلم: "ما نقص مال من صدقة" (رواه مسلم)، فنحن نؤمن أن الإحسان يزيد البركة، ولا ينقص الخير الذي بين أيدينا. إن أفكاركم ومشاركتكم البنّاءة هي الأساس الذي يرتقي بهذا المنتدى ويثريه، فكل فكرة تخرج من القلب تصل إلى القلب، وكل رأي إيجابي يساهم في بناء مستقبل مشرق لنا جميعًا. هيا بنا نتكاتف، ونفتح باب الحوار البناء في هذه الفكرة، ليصبح منتدى أوفيسنا منارةً للعلم والتعاون المستدام. نسأل الله أن يجعلنا جميعا من الذين يساهمون في الخير، ويعينون الناس على أمور حياتهم، ويُرزقون بسبب إحسانهم. والسلام عليكم ورحمة الله وبركاته. محبكم محمد صالح

جميل وشاكر جدا بس انا عايز وانا في النموذج بمجرد ان اضغط علي كنترول + t تتفعل تلقائى التعديل واقدر اعدل في النموذج مايكرو AutoKeys