اابو خالد قام بنشر يوليو 26, 2019 قام بنشر يوليو 26, 2019 السلام عليكم ورحمة الله وبركاته يعطيكم الف عافيه ياشباب ارجو التكرم على مساعدتى فالأمر صعب جدا بالنسبة لى الطلب اريد ان اعمل خانه اسجل بها اسم في صفحه وتحفظ هذا الاسم في صفحة ثانية مع العلم الصفة الاولى تكون ثابته يعني مثال الاسم : ابو خالد وتكون فيه ايقونة حفظ عند الظغط عليها يختفي الاسم ويحفظ في صفحة ثانية ويكون مربع الاسم متاح لكتابة اسم ثاني ( ادخال بيانات بدون تغيير المربع اعرف اني طولت عليكم في الشرح لاني لا اعرف كيف اجعل المعلومة تصل اليكم وان شاء الله تكون قد وصلة شاكر ومقدر لكم جميعا
أفضل إجابة سليم حاصبيا قام بنشر يوليو 27, 2019 أفضل إجابة قام بنشر يوليو 27, 2019 حسب ما فهمت من السؤال ربما يكون هذا الملف نموذج عما تريد اذا ادركت انك ادرجت اسماً بالخطأ اضغط على الزر Undo كلما ضغطت مرة على Undo تستطيع أن تمسح اخر تسجيل في الصفحة الثانية اذا اردت مسح كل البيانات من الصفحة الثانية اضغط على الزر Clear Data Direct to Other_Sheet.xlsm 3
اابو خالد قام بنشر يوليو 27, 2019 الكاتب قام بنشر يوليو 27, 2019 نعم هذا الذي اقصده ياليتك ترسلي طريقة عمل ذالك بارك الله فيك وبأمثالك 1
أحمد يوسف قام بنشر يوليو 27, 2019 قام بنشر يوليو 27, 2019 أخى الكريم ,عليك بتتبع الأكواد الموجود بالملف ومحاولة دراستها والعمل على فهمها 1
سليم حاصبيا قام بنشر يوليو 27, 2019 قام بنشر يوليو 27, 2019 rigth Click على اي زر من الازرار ثم Assign Macro ثم Edit 1
أحمد يوسف قام بنشر يوليو 28, 2019 قام بنشر يوليو 28, 2019 هذا هو الكود المستخدم كما اخبرك الأستاذ سليم -الأمر في غاية البساطة فيمكنك تتبع هذا الكود وفهمه Option Explicit Sub Save_for_Me() Dim answer As Byte Dim M As Worksheet: Set M = Sheets("Main") Dim F As Worksheet: Set F = Sheets("For_Save") Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row + 1 Dim fnd As Range Set fnd = F.Columns("A").Find(M.Cells(2, 1), lookat:=1) If Not fnd Is Nothing Then answer = MsgBox("هذه المعلومة موجودة" & Chr(10) & _ " هل تريد المتابعة", 36, "Attention") If answer = 6 Then F.Cells(lrF, 1) = M.Cells(2, 1) F.Cells(lrF, 2) = Date F.Cells(lrF, 3) = Time Exit Sub End If Else F.Cells(lrF, 1) = M.Cells(2, 1) F.Cells(lrF, 2) = Date F.Cells(lrF, 3) = Time End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim F As Worksheet: Set F = Sheets("For_Save") Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row If Target.Address = "$A$2" Then Save_for_Me lrF = F.Cells(Rows.Count, 1).End(3).Row If lrF = 1 Then GoTo End_Me Sheets("Main").Cells(2, "G").Resize(, 3).Value = _ F.Cells(lrF, 1).Resize(, 3).Value End If End_Me: Application.EnableEvents = True End Sub Sub Undo_for_me() Dim F As Worksheet: Set F = Sheets("For_Save") Application.EnableEvents = False Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row If lrF = 1 Then GoTo End_Me F.Cells(lrF, 1).Resize(, 3).ClearContents lrF = F.Cells(Rows.Count, 1).End(3).Row Sheets("Main").Cells(2, "G").Resize(, 3).Value = F.Cells(lrF, 1).Resize(, 3).Value End_Me: Application.EnableEvents = True End Sub Sub Clear_all() Application.EnableEvents = False Dim F As Worksheet: Set F = Sheets("For_Save") Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row Dim answer As Byte answer = MsgBox("أنت تقوم بمسح كل البيانات في الصفحة For _save " & Chr(10) & _ " هل انت متأكد من هذا", 1048628, "Attention") If answer <> 6 Then GoTo End_Me If lrF = 1 Then lrF = 2 F.Cells(2, 1).Resize(lrF - 1, 3).ClearContents Me.Cells(2, "G").Resize(, 3).ClearContents End_Me: Application.EnableEvents = True End Sub 1
اابو خالد قام بنشر يوليو 28, 2019 الكاتب قام بنشر يوليو 28, 2019 اشكرك اخي الاستاذ احمد على كل ما قدمته لمساعدتي
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.