حسين مامون

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

بعد ادن الاستاد انظر المرفق يمكن اضافة اضافة مربعات نص اخرى كمان يمكن الطباعة بدل الاستعلام 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