حسين مامون

طهورا ان شاء الله

بعد ادن الاستاد انظر المرفق يمكن اضافة اضافة مربعات نص اخرى كمان يمكن الطباعة بدل الاستعلام test.accdb

انظر الصور

السلام عليكم ورحمة الله بعد ادن الاخوان الكرام جرب هدا التعديل في المرفق لعله ما تريد وان كان ما تقصد سنعدله ليضيف البيان الى قاعدة البيانات ملاحظة: تم تغيير اسم القاعدة الترقيم السنوي.accdb

عليكم السلام جرب كما في الصورة

وعليكم السلام انسخ الماكرو الى محرر الاكواد واحفظ الملف بصيغة xlsm ثم جرب Sub copy_tous() Dim ws As Worksheet Dim Aws As Worksheet Dim lr Set ws = Sheets("Data") Set Aws = ActiveSheet lr = ws.Cells(Rows.Count, 1).End(3).Row ws.Range("a2:ar" & lr).Copy Aws.Range("a2") msgbox"تم النسخ بنجاح" End Sub

اخي قلت ليست لي فكرة عن هذا يعني عن برمجتها

ليست لي فكرة عن هذا ولم اجد في الفورم اي اداة اخرى غير Textbox و label

تفضل جرب قمت باضافة listbox لعرض محتوى الصفحة جرب.xlsm

جواب على قد سؤالك هو هذا Private Sub TextBox2_Change() If TextBox2 > 0 Then TextBox3.Value = Val(TextBox1) End If End Sub

انظر المرفق test2022.xlsx

ربما قرعة(3).xlsm

اخي الكريم تشكر يجب توضيح المشكل الذي واجهته مع الكود لتلقي المساعدة من احد الاخوة وتفادي هدر وقتك ووقت الاخرون جرب المرفق ملف طلب المساعدة (1).xlsm

جرب هذا الماكرو فيه حلقة تكرارية تفحص التاريخ في العمود F ويدرج COMMANT قبل عشرة ايام Sub test() 'On Error Resume Next Dim lr Dim x Dim dt: dt = Date Dim dt2: dt2 = Format(DateAdd("d", -10, dt), "dd-mm-yyyy") With Sheets("نشاط") lr = .Cells(Rows.Count, "f").End(xlUp).Row .Range("f3:f" & lr).ClearComments For x = 3 To lr If Not IsDate(.Cells(x, "f")) = True Then GoTo 1 If CDate(Cells(x, "f")) = dt2 Then .Cells(x, "f").AddComment .Cells(x, "f").Comment.Visible = True .Cells(x, "f").Comment.Text Text:=":" & Chr(10) & "عشرة ايام متبقية " End If 1: Next x End With End Sub

تفضل ترحيل بيانات.xlsm

اليك ما تريد في هذه المشاركة

نعم تم التعديل الكود الان يقوم بالغاء اي الوان في الجدول و يلون السطر المعني فقط

الكود شغال 100/100 بس فيه شرط لي هو ينفذ الامر في اليوم 14 في الشهر انظر الصورة لتجربة الكود اكتب رقم 8 عوض 14

كان طلبك تنسيق الارقام ولكن هناك مشاركة ربما فيها ما تريد https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=214255&key=963ce63aa311dfeead73411430b422e6

تفضل Nouveau Feuille de calcul Microsoft Excel (2).xlsm

جرب لم يعد يعطي خطأ السبب عندي اسم الورقة قرعة(3).xlsm

ربما هكذا احسن Private Sub TextBox1_AfterUpdate() [d3] = Format(TextBox1, "dd-mm-yyyy") End Sub Private Sub TextBox1_Change() '[d3].Value = TextBox1.Value End Sub Private Sub TextBox2_AfterUpdate() [d3] = Format(TextBox2, "dd-mm-yyyy") End Sub Private Sub TextBox2_Change() '[d4].Value = TextBox2.Value End Sub

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

اولا اسم الشيت في الكود فيه خطأ وايضا سطر المتغير lastrow قيه خطأ واسم الفورم ايضا

جرب التعديل البحث بين تاريخين 1515 officena.xlsm