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

وعليكم السلام ورحمة الله وبركاته ... بالنسبة للمطلوب الاول : الأفضل يبقى كما هو ... لأنك قد تظطر الى الغاء الفاتورة مثلا ..... لكن حسب رغبتك تفضل ...... انقل هذا الكود من زر الحفظ الى حدث النموذج عند الفتح Forms!Form1.ID = Nz(DMax("[ID]", "InvoiceSavetbl") + 1) Forms!Form1.InvoiceID1 = Year(Date) & "- " & Forms!Form1.ID.Value بالنسبة للمطلوب الثاني : للاسف غير مفهوم لي !!!!!!

تفضل جرب ............... On Error Resume Next If IsNull(Me.tslsul) Then Me.Undo Me.U1.SetFocus Else If MsgBox("هل تريد الحذف فعلاً ؟", vbYesNo + vbCritical + vbMsgBoxRight + vbDefaultButton2, "تحذير") = vbNo Then Me.U1.SetFocus Exit Sub Else Dim i As Integer, k As Integer 'k = tag1![COU] 'و مهمته هي حساب عدد السجلات لتكرار الكود' ' المربع موجود في النموذج لفرعي Tag1 Me.tag1.SetFocus DoCmd.GoToRecord , , acFirst For i = 1 To [Forms]![Tag]![tag1].Form![COU] DoCmd.SetWarnings False DoCmd.RunSQL " UPDATE hmola SET hmola.tag = false WHERE (((hmola.byan)=[Forms]![tag]![tag1].Form![byan]));" DoCmd.SetWarnings True DoCmd.GoToRecord , , acNext Next i [Forms]![Tag]![esm].SetFocus DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True Me.Refresh MsgBox "تمت عملية الحذف بنجاح", , "تم" Me.U1.SetFocus End If End If

يجب أن يكون هذا السطر كالتالي: Forms!Form1.ID = Nz(DMax("[ID]", "InvoiceSavetbl"),0) + 1 أو هكذا Forms!Form1.ID = Nz(DMax("[ID]", "InvoiceSavetbl")) + 1 والأولى أفضل لن تظهر عندكم المشكلة قبل التصحيح إلا إذا كان الجدول فارغا.

طيب .... جرب المرفق .... DB5 (1).mdb

وعليكم السلام 🙂 إذا ما عندك برنامج قراءة pdf على كمبيوترك (مثل Adobe Acrobat Reader او Fox it pdf Reader او ... ) ، فالاكسس لن يعرض ملف الـ pdf في النموذج ، وانما يُخرج لك هذه الرسالة !! تابع هذا الموضوع: فعندك حلين: 1. تنصب احد برامج قراءة pdf على كمبيوترك ، 2. او تفتح ملف pdf باليرنامح الافتراضي والذي قد يكون المتصفح Chrome او Edge. جعفر

ما هو الكود المستخدم لفتح الصور ؟

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

وعليكم السلام 🙂 هذا ليس حلا مقبولا إلا في حالات نادرة ، وهذه ليست منها !! في اول مشاركة لي ، وضعت لك حلين ، احدهم المجلد الموثوق به ، والآخر رابط به مجموعة حلول اخرى ، فآن الاوان ان تنظر فيها 🙂 جعفر

هذا الموضوع متوفر في المنتدى فقط ابحث وستجده بدلا من تكرار نفس المواضيع https://www.officeforworld.com/2019/05/10-listbox-excel-vba.html

وعليكم السلام .. يمكنك استخدام هذه المعادلة فى عمود المعدل G =F2/COUNT(B2:E2) وهذه المعادلة لعمود الحالة E =IF(D11<>"","مفصول",IF(C11<$A$9,"متخرج","مزاول")) كتابة الدالة1 if.xlsx

الحمد الله رب العالمين واياك اخي محمد

لم افهم ما المقصود ببقية الكود

طيب جرب كودك الان .................... On Error Resume Next If IsNull(Me.tslsul) Then Me.Undo Me.U1.SetFocus Else If MsgBox("هل تريد الحذف فعلاً ؟", vbYesNo + vbCritical + vbMsgBoxRight + vbDefaultButton2, "تحذير") = vbNo Then Me.U1.SetFocus Exit Sub Else Dim i As Integer, k As Integer 'k = tag1![COU] 'و مهمته هي حساب عدد السجلات لتكرار الكود' ' المربع موجود في النموذج لفرعي Tag1 Me.tag1.SetFocus DoCmd.GoToRecord , , acFirst For i = 1 To [Forms]![Tag]![tag1].Form![COU] DoCmd.SetWarnings False DoCmd.RunSQL " UPDATE hmola SET hmola.tag = false WHERE (((hmola.byan)=[Forms]![tag]![tag1].Form![byan]));" DoCmd.SetWarnings True DoCmd.GoToRecord , , acNext Next i DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True Me.Refresh MsgBox "تمت عملية الحذف بنجاح", , "تم" Me.U1.SetFocus End If End If

طيب .. انا على الموبايل ... ارجع ووافيك

كلام اخي ابا البشر ... صحيح ولكن هل الجدول tag1 يحوي سجلات غير المعروضة في النموذج الفرعي

هل جربت الكود يا اخ محمد ليس الجميع بل يقوم بتحديث الحقل حسب رقم البيان في الجدول tag1 تمع في الكود

جرب هذا الكود بدل الموجود لديك ........................ On Error Resume Next If IsNull(Me.tslsul) Then Me.Undo Me.U1.SetFocus Else If MsgBox("هل تريد الحذف فعلاً ؟", vbYesNo + vbCritical + vbMsgBoxRight + vbDefaultButton2, "تحذير") = vbNo Then Me.U1.SetFocus Exit Sub Else DoCmd.SetWarnings False DoCmd.RunSQL " UPDATE tag1 INNER JOIN hmola ON tag1.byan = hmola.BYAN SET hmola.tag = False;" DoCmd.SetWarnings True DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True Me.Refresh MsgBox "تمت عملية الحذف بنجاح", , "تم" Me.U1.SetFocus End If End If

الحمد لله تقلص الحل إلى سطر واحد فقط 🙂 TreeView1.Nodes("A" & Me.AccID).Selected = True الأخ @محمد القدسي لقد قمت بتنظيم الكود كشكل فقط لتسهيل المراجعة وفهم أدائه. سأجعل هذا المثال لدراسة الشجرة والوصول إلى حلول جديدة إن وجدت. شجرة حسابات_04.rar

الكود شغال .... ماذا تريد بالضبط ... ممكن شرط مبسط ؟؟؟

تفضل أخي مدحت 🙂

وعليكم السلام ورحمة الله وبركاته عدل هذا السطر If ws.Cells(r, c + 1).Value2 >= myDate Then ليصبح هكذا If ws.Cells(r, c + 1).Value2 >= myDate and If ws.Cells(r, c + 1).Value2 <= CLng(DateSerial(2019, 1, 1)) Then

الله يجزاكي خيرا والله من امس وانا ادور على حل ..جزاكي الله خيرا

وعليكم السلام ورحمة الله وبركاته من هنا البدايه https://www.officena.net/ib/topic/37509-ساعه-رقمي-وتناظري

انتبه من فضلك فطلبك ليس بالسهل أو الهين !!!!

السلام عليكم أخي الكريم هذا كود تفقيط جزى الله خيراً من عمله ووضعه بين أيدي الناس ليعملوا به يمكنك تعديله ليناسب عملك Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String 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 String 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 If TheNo > 999999999999.99 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) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(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 ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان" End If 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 End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd 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

أخي أحيانا الشرح يحتاج وقتا أكثر من وقت الحل. رؤوس أقلام: - حذف يوم من حقل "التاريخ" ليوافق نتائجك. - ركزت على حقل اليوم على أن لا يكون أقل من صفر أو يكون بطول شهر حقل "التاريخ" بعد إنقاصه يوما: فإذا كان أقل من صفر عدلت قيمته إلى صفر وإذا كان بطول الشهر كذلك صفرته وزدت الشهور شهرا وإذا وصلت الشهور 12 صفرت الشهور وزدت السنين سنة. حتى لا تتعب رأسك حول المعادلات إلى دالة vba أو ابحث عن دالة جاهزة من عمل الأستاذ جعفر بمنتدى الأكسس.

السلام عليكم محتاج دالة للبحث عن اسم داخل شيتات الاشهر واستدعاء بيانات الاسم كشف حدادين 2021.xlsx

استاذ جعفر @jjafferr بالرغم من روعتها الا انها طريقة قاتلة انظر الى هذا المثال المشابه MultiLingualSample.zip

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

عليك بهذا الماكرو Option Explicit Sub tahweel() Dim my_rg Dim i% Dim my_st: my_st = Chr(201) Set my_rg = Sheets("Salim").Range(Range("a2"), Range("a2").End(4)) my_rg.Offset(, 2).ClearContents For i = 1 To my_rg.Rows.Count With my_rg.Cells(i) If .Value = "انثى" Then .Offset(, 2).Value = _ my_rg.Cells(i).Offset(, 1) & my_st Else .Offset(, 2).Value = _ my_rg.Cells(i).Offset(, 1) End If End With Next End Sub الملف Mouslm.xlsm