اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمة الله وبركاته

يعطيكم الف عافيه ياشباب

ارجو التكرم على مساعدتى فالأمر صعب جدا بالنسبة لى

الطلب

اريد ان اعمل خانه اسجل بها اسم في صفحه وتحفظ هذا الاسم في صفحة ثانية مع العلم الصفة الاولى تكون ثابته يعني مثال

الاسم : ابو خالد وتكون فيه ايقونة حفظ عند الظغط عليها يختفي الاسم ويحفظ في صفحة ثانية ويكون مربع الاسم متاح لكتابة اسم ثاني 

( ادخال بيانات بدون تغيير المربع

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

شاكر ومقدر لكم جميعا

  • أفضل إجابة
قام بنشر

حسب ما فهمت من السؤال ربما يكون هذا الملف نموذج عما تريد

اذا ادركت  انك ادرجت اسماً بالخطأ اضغط على الزر Undo

كلما ضغطت مرة على Undo تستطيع أن تمسح اخر تسجيل في الصفحة الثانية

اذا اردت مسح كل البيانات من الصفحة الثانية اضغط على الزر Clear Data

 

Direct to Other_Sheet.xlsm

  • Like 3
قام بنشر

هذا هو الكود المستخدم كما اخبرك الأستاذ سليم -الأمر في غاية البساطة فيمكنك تتبع هذا الكود وفهمه

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

 

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information