محمد أبوعبدالله

بالاضافة الى ما تفضل به استانا الفاضل @husamwahab وله جزيل الشكر تفضل هذه وحدة نمطية ايسر من اللتي تسخدمها ومرنة في التعديل Public Function write_Number(numberp) On Error Resume Next Dim ttpa, xp, a, number_s, fl As String Dim zp, z As Integer Dim c1, c2, c3 As String number_s = Str(Format(numberp, "0.00")) If Left(Right(number_s, 2), 1) = "." Then number_s = number_s & "0" If Left(Right(number_s, 3), 1) <> "." Then number_s = number_s & ".00" number_s = Trim(number_s) zp = Len(number_s) z = 1 Do While zp > 0 c1 = "" c2 = "" c3 = "" If zp = 12 Or zp = 9 Or zp = 6 Then a = Mid(number_s, z, 1) zp = zp - 1 Select Case a Case "0" c3 = "" Case "1" c3 = "ومائة " Case "2" c3 = "ومائتان " Case "3" c3 = "وثلاثمائة " Case "4" c3 = "واربعمائة " Case "5" c3 = "وخمسمائة " Case "6" c3 = "وستمائة " Case "7" c3 = "وسبعمائة " Case "8" c3 = "وثمانمائة " Case "9" c3 = "وتسعمائة " End Select z = z + 1 End If If zp = 3 Then z = z + 1 zp = zp - 1 End If a = Mid(number_s, z, 1) If zp = 2 Or zp = 5 Or zp = 8 Or zp = 11 Then Select Case a Case "0" c2 = "" Case "1" c2 = "عشر " Case "2" c2 = "وعشرون " Case "3" c2 = "وثلاثون " Case "4" c2 = "واربعون " Case "5" c2 = "وخمسون " Case "6" c2 = "وستون " Case "7" c2 = "وسبعون " Case "8" c2 = "وثمانون " Case "9" c2 = "وتسعون " End Select zp = zp - 1 z = z + 1 End If a = Mid(number_s, z, 1) If zp = 1 Then ' الهللات Select Case a Case "0" c1 = "" Case "1" If c2 = "عشر " Then c1 = "واحدى " Else c1 = "وواحد " End If Case "2" If c2 = "عشر " Then c1 = "واثنتا " Else c1 = "واثناتان " End If Case "3" c1 = "وثلاث " Case "4" c1 = "واربع " Case "5" c1 = "وخمس " Case "6" c1 = "وست " Case "7" c1 = "وسبع " Case "8" c1 = "وثمان " Case "9" c1 = "وتسع " End Select Else ' الريالات Select Case a Case "0" c1 = "" If c2 = "عشر " Then c2 = "وعشرة " End If Case "1" If c2 = "عشر " Then c1 = "واحدى " Else c1 = "وواحد " End If Case "2" If c2 = "عشر " Then c1 = "واثنا " Else c1 = "واثنان " End If Case "3" c1 = "وثلاثة " Case "4" c1 = "واربعة " Case "5" c1 = "وخمسة " Case "6" c1 = "وستة " Case "7" c1 = "وسبعة " Case "8" c1 = "وثمانية " Case "9" c1 = "وتسعة " End Select End If zp = zp - 1 z = z + 1 Select Case zp Case 9 Select Case c1 + c2 + c3 Case "وواحد " xp = xp + "ومليون " Case "واثنان " xp = xp + "ومليونان" Case Else xp = xp + c3 + c1 + c2 + "مليون " End Select Case 6 Select Case c1 + c2 + c3 Case "وواحد " xp = xp + "والف " Case "واثنان " xp = xp + "والفان " Case "وثلاثة " xp = xp + "وثلاثة الاف " Case "واربعة " xp = xp + "واربعة الاف " Case "وخمسة " xp = xp + "وخمسة الاف " Case "وستة " xp = xp + "وستة الاف " Case "وسبعة " xp = xp + "وسبعة الاف " Case "وثمانية " xp = xp + "وثمانية الاف " Case "وتسعة " xp = xp + "وتسعة الاف " Case Else If c2 = "وعشرة " Then xp = xp + c3 + c1 + c2 + "الاف " Else xp = xp + c3 + c1 + c2 + "الف " End If End Select Case 3 If c2 = "" Then Select Case c1 Case "وواحد " c1 = "ديناراً " Case "واثنان " c1 = "ديناراًن " Case "وثلاثة " c1 = "وثلاثة دينارات " Case "واربعة " c1 = "واربعة دينارات " Case "وخمسة " c1 = "وخمسة دينارات " Case "وستة " c1 = "وستة دينارات " Case "وسبعة " c1 = "وسبعة دينارات " Case "وثمانية " c1 = "وثمانية دينارات " Case "وتسعة " c1 = "وتسعة دينارات " Case Else c1 = "ديناراً " End Select xp = xp + c3 + c1 + c2 Else xp = xp + c3 + c1 + c2 + "ديناراً " End If Case 0 If c1 + c2 <> "" Then If c2 = "" Then Select Case c1 Case "وواحد " xp = xp + "وسنتيماً واحداً" Case "واثنان " xp = xp + "وسنتيمان " Case Else xp = xp + c1 + "سنتيم " End Select Else xp = xp + c1 + c2 + "سنتيم " End If Else xp = xp + c1 + c2 + "وصفر سنتيم " End If End Select Loop xp = LTrim(xp) zp = Len(xp) - 1 If Left(xp, 1) = "و" Then xp = Mid(xp, 2, zp) End If ttpa = xp write_Number = ttpa End Function طريقة الاستخدام في الاستعلام او النموذج او التقرير كالتالي write_Number([textbox]) تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم ارجو ان يكون هو المطلوب UPكورونا.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub AddAndDelet_Click() DoCmd.SetWarnings False DoCmd.OpenQuery "Q1" DoCmd.OpenQuery "Q11" DoCmd.SetWarnings True Me.Requery MsgBox "تم اضافه السجل للجدول الثانى وحذفه من الجدول الاول" End Sub تحياتي

بنفس الطريقة اخي الكريم المستخدم.rar تحياتي

ضع مثال ليتم التعديل عليه باذن الله تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم المستخدم.rar اخي بلال طلب من فضلك حاول بقدر الامكان كتابة اسماء العناصر ( مربع نص - مربع تحرير وسرد ... الخ ) باسماء لاتينية (انجليزية) اولاً لتجنب الاخطاء فيما بعد ثانياً لتسهيل كتابة الكود او المعيار فيما بعد تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم مثال علي تجمع الحقول.rar تحياتي

اتفضل اخي الكريم جرب واعلمني بالنتيجة مثال.rar تحياتي

لا يوجد موظفين ولا يوجد نموذج يحدد اسم الموظف او رقمه برجاء تحديد الجدول المصدر في قاعدة البيانات 2 واين تريد الحاقه في قاعدة بيانات 1 وانشاء نموذج به اسم الموظف ليتم عليه التنفيذ تحياتي

وعليكم السلام ورحمة الله وبركاته 1 - ربط الجدول بالقاعدة 2 - عمل استعلام الحاق 3 - وضع معيار في الاستعلام حسب معرف الموظف 4 - تشغيل الاستعلام تحياتي

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

تم استخدام for i >>> next لتكرار امر الطباعة حسب العدد الموجود بحقل CARNUM For i = 1 To Forms!cusform!CARNUM DoCmd.OpenReport "cusreport", acViewNormal, , "CUSNUM = " & Forms!cusform!CUSNUM Next ثم استخدمنا المتغيير العام i في خقل X5 الموجود في التقرير ليكتب عدد النسخ Public i As Integer Private Sub تفصيل_Format(Cancel As Integer, FormatCount As Integer) Me.x5 = i End Sub تحياتي

جرب استخدام استعلام توحيد SELECT ID, n1 FROM Table1 UNION SELECT Id, n2 FROM Table2; or SELECT ID, n1 FROM Table1 UNION ALL SELECT Id, n2 FROM Table2; db21.rar تحياتي

تفضل اخي الكريم البرنامج-bb.rar تحياتي

وعليكم السلام ورجمة الله وبركاته انظر الاستعلام الذي بالمرفق تحياتي db21.rar

وعليكم السلام ورحمة الله وبركاته هل تقصد الكود الموجود في نموذج t2 اضف الكود التالي Me.Requery كود زر الامر كاملا DoCmd.SetWarnings False DoCmd.OpenQuery "Q11" DoCmd.OpenQuery "Q12" DoCmd.SetWarnings True Me.Requery MsgBox "تم اضافه السجل للجدول الثانى وحذفه من الجدول الاول" تحياتي

او استخدم المثال الموجود في المشاركة التالية تحياتي

السلام عليكم قم بعمل ضغط واصلاح لقاعدة البيانات او استخدم البرنامج التالي تحياتي

وعليكم السلام ورحمة الله وبركاته اضف الكود التالي في وحدة نمطية جديدة Option Compare Database Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Sub HideAccess() Call ShowWindow(Access.hWndAccessApp, 0) End Sub Public Sub ShowAccess() Call ShowWindow(Access.hWndAccessApp, 5) End Sub ثم اسدعاء الكود في النموذج الرئيسي ' اخفاء Call HideAccess ' اظهار Call ShowAccess مع تعيين النموذج الرئيسي في بداية التشغيل تحياتي

هل الكود لا يعمل ام الملف نفسه الذي لا يعمل رفع لك الملف مرة اخرى بدون ضغط NEW FROM NUM.accdb تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم NEW FROM NUM.rar تحياتي

السلام عليكم ممكن باستخدام عوامل التصفية تحياتي

تفضل اخي الكريم التعديل الاخير يعمل بشكل جيد ان شاء الله UPP-1.rar تحياتي

السلام عليكم تفضل اخي الكريم سيتم تحديث حقل sallary + الزيادة المذكورة في حقل percent Private Sub Command13_Click() DoCmd.GoToRecord acDataForm, Me.Name, acFirst mySQL = "Select * From sub" Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) For i = 1 To Me.RecordsetClone.RecordCount rst.Edit rst!sallary = rst!sallary + (rst!sallary * Me.percent) rst.Update rst.MoveNext DoCmd.RunCommand acCmdRecordsGoToNext Next If Me.CurrentRecord = Me.RecordsetClone.RecordCount Then Exit Sub DoCmd.GoToRecord acDataForm, Me.Name, acFirst rst.Close: Set rst = Nothing Me.Child9.Requery End Sub update.accdb تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Dim aFile As String aFile = CurrentProject.Path & "\" & "YY.txt" If Len(Dir$(aFile)) > 0 Then Kill aFile End If تحياتي