اذهب الي المحتوي
أوفيسنا

أريد أبسط حل لهذا الإستدعاء ثم الترحيل والحفظ - يوجد مثال-


إذهب إلى أفضل إجابة Solved by زوهير,

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

لقد قمت بعمل زر الترحيل حسب شرح أحد الإخوة في المنتدى فجزاه الله خيرا، وهو مبسط وسهل جدا.

 

المشكل الآن أريد طريقة سهلة جدا وشرح مبسط غفر الله لوالديكم:

 

 

1- لإستدعاء البيانات مع التعديل عليها والترحيل من جديد

( اي الحفظ في نفس السطر القديم للبيانات بعد التغييرات الجديدة إن وجدت تغييرات، مع ظهور مربع حواري ينبه أنه هناك تغييرات ، فيسأل الشخص هل يريد الحفظ بعد التغييرات حقا أم لا؟)

 

 

2- وكيف يكون الإستدعاء: إما بكود الموظف أو باسمه.

كود ترحيل جميل جدا.rar

تم تعديل بواسطه شكيب عمار
رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليك اخي الكريم

 

اليك الحل كاملا بالفورم ترحيل استدعاء تعديل

 

ان نسابك الحل اضغط افضل اجابة لتمام الموضوع

كود ترحيل جميل جدا.rar

  • Like 1
رابط هذا التعليق
شارك

هل شرح كيفية عمل الفورم

او شرح الاكواد كلها

لانه ليس كود واحد بل هناك مجموعة من الاكواد

وكل كود على حدى

--------------------------------------------------------------

الفورم

---------------------------

اذا كنت تريد جلب البيانات

1 ضع في الخانة الاولى او التاكست بوكس رقم الموظف

واضغط على استدعاء سيتم جلب البانات

2- بعد جلب البيانات داخل الليست بوكس قم بتحديدها سيتم ظهورها

في التاكست بوكس قم بتغيير ماتريد تغييره ثم اضغط تعديل سيتم التعديل في نفس المكان وهكذا

رابط هذا التعليق
شارك

الأخ المتميز زوهير

بارك الله فيك على هذا الكود الرائع

جزيت خير الجزاء

:signthankspin:

أخي الكريم شكيب عمار .. موضوع الشرح مرهق للغاية استغرق مني الشرح حوالي ساعة ونصف :yes: :yes:

(لا تنسى أن تضغط على كلمة "أعجبني هذا") ولا تضغط على كلمة "تحديد كأفضل إجابة" إذ أن مشاركتي ليست بإجابة إنما هي شرح لما تفضل به الرائع زوهير

Option Explicit

'يوضع الكود في حدث الفورم ليتم إضافة واستدعاء وتعديل البيانات
'البيانات في ورقة عمل باسم "ورقة 2" والصف الأول يحمل العناوين الآتية
'كود الموظف - الاسم واللقب - تاريخ الميلاد - الوظيفة
'يتم إنشاء مربع نص للكود وآخر للاسم وآخر لتاريخ الميلاد وآخر للوظيفة
'وزري أمر للاستدعاء والتعديل [ListBox1] ويوضع داخله مربع القائمة [Frame1] يتم إنشاء إطار
'بعنوان البحث والتعديل كما يتم إنشاء زر أمر باسم إضافة [CheckBox1] يتم إنشاء
'---------------------------------------------------------------------------------------

Private Sub CheckBox1_Click()
'حيث أن لمربع الفحص قيمتان [CheckBox1] يقوم الكود بالعمل عند النقر على
'[True] إذا كان المربع تم تحديده أي وضع علامة صح فإنه يحمل القيمة
'[False] إذا كان المربع لم يتم تحديده أي أنه لا توجد علامة صح فإنه يحمل القيمة
'---------------------------------------------------------------------------
'[True] فإذا كانت القيمة تساوي
    If CheckBox1.Value Then
'يظهر الإطار بما في داخله من أدوات
        Frame1.Visible = True
'[False] وإذا كانت القيمة تساوي
    Else
'يختفي الإطار بما في داخله من أدوات
        Frame1.Visible = False
    End If
End Sub

Private Sub CommandButton1_Click()
'يتم تنفيذ الأسطر عند النقر على زر الإضافة
'---------------------------------------
    Dim iRow As Long, I As Long
'سطر لتنشيط أو تحديد ورقة العمل الهدف
    Sheets(2).Activate
'تعيين قيمة للمتغير ليساوي رقم آخر صف به بيانات في العمود الأول
    iRow = Range("A" & Rows.Count).End(xlUp).Row
'في آخر صف به بيانات يتم الإشارة إلى الصف التالي لأنه أول صف فارغ
'توضع قيمة مربع النص الأول في العمود الأول
    Range("A" & iRow + 1).Value = TextBox1.Value
'تتم الإزاحة إلى الخلية المجاورة بمقدار عمود واحد وتوضع قيمة مربع النص الثاني
    Range("A" & iRow + 1).Offset(0, 1).Value = TextBox2.Value
'تتم الإزاحة إلى الخلية المجاورة بمقدار عمودين وتوضع قيمة مربع النص الثالث
'يتم تنسيق مربع النص لتاريخ الميلاد لتظر بهذا التنسيق المذكور في السطر
    Range("A" & iRow + 1).Offset(0, 2).Value = Format(TextBox3, "yyyy/dd/mm")
'تتم الإزاحة إلى الخلية المجاورة بمقدار ثلاثة أعمدة وتوضع قيمة مربع النص الرابع
    Range("A" & iRow + 1).Offset(0, 3).Value = TextBox4.Value

'حلقة تكرارية لمسح مربعات النصوص الأربعة بعد ترحيل البيانات
    For I = 1 To 4
        Controls("TextBox" & I).Value = ""
    Next I
End Sub

Private Sub CommandButton2_Click()
'يتم تنفيذ الأسطر عند النقر على زر الاستدعاء
'-----------------------------------------
'الإعلان عن المتغيرات
    Dim Zouhir As Worksheet
    Dim V As Integer, LastRow As Integer
    Dim M As String
    Dim Q, F

'سطر لتنشيط أو تحديد ورقة العمل الهدف
    Sheets(2).Activate
'[ListBox1] إظهار مربع القائمة
    ListBox1.Visible = True
'سطر لتجنب حدوث خطأ
    On Error Resume Next
'مسح البيانات داخل مربع القائمة
    ListBox1.Clear
'إذا كان مربع النص الأول فارغ يتم القفز إلى السطر الذي بدايته رقم 1
'أي إنهاء الإجراء الفرعي
    If TextBox1.Text = "" Then GoTo 1
'تعيين قيمة للمتغير ليساوي قيمة مربع النص الأول
    M = TextBox1.Text
'تعيين قيمة للمتغير ليساوي ورقة العمل الهدف
    Set Zouhir = Sheets(2)
'بدء التعامل مع ورقة العمل
    With Zouhir
'تعيين قيمة للمتغير ليساوي رقم آخر صف به بيانات في العمود الأول
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'تعيين المتغير ليساوي النطاق الذي يطابق البحث عن قيمة مربع النص
        Set Q = .Range("A2:A" & LastRow).Find(M)
'إذا تم إيجاد الكود الذي يطابق مربع النص
        If Not Q Is Nothing Then
'يتم تعيين قيمة للمتغير ليساوي عنوان الخلية التي طابقت عملية البحث
            F = Q.Address
'حلقة تكرارية تنفذ إلى أن تنتهي نتائج البحث عن القيمة الموجودة بمربع النص
            Do
'سطر يستخدم دالة البحث عن قيمة مربع النص داخل النطاق فإذا كانت النتيجة تساوي 1
                If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then
'يتم إضافة العناصر إلى مربع القائمة
'عبارة عن صفوف وأعمدة والصفوف تمثل الفهرس الذي يبدأ من صفر [ListBox1] مربع القائمة
'لم يتم تعيين قيمة له في الأسطر السابقة لذا فإنه يحمل القيمة صفر [V] المتغير المسمى
'تمثل الأرقام 1 و 2 و 3 و 4 أرقام الأعمدة في مربع القائمة
                    ListBox1.AddItem Q.Value
                    ListBox1.List(V, 1) = Q.Offset(0, 1).Value
                    ListBox1.List(V, 2) = Q.Offset(0, 2).Value
                    ListBox1.List(V, 3) = Q.Offset(0, 3).Value
                    ListBox1.List(V, 4) = Q.Offset(0, 4).Value
'العمود الخامس في مربع القائمة وهو وهمي ليحمل عنوان النطاق الحالي المطابق للبحث
                    ListBox1.List(V, 5) = Q.Address
'زيادة قيمة المتغير بمقدار واحد
                    V = V + 1
                End If
'مرة أخرى ليساوي هذه المرة نتيجة البحث التالية [Q] تعيين المتغير المسمى
                Set Q = .Range("A2:A" & LastRow).FindNext(Q)
            Loop While Not Q Is Nothing And Q.Address <> F
        End If
    End With
1 End Sub

Private Sub CommandButton3_Click()
'يتم تنفيذ الأسطر عند النقر على زر التعديل
'-----------------------------------------
'الإعلان عن المتغيرات
    Dim Zouh As String
    Dim MYSH As Worksheet
    Dim MSG As String
    Dim ANS As Integer
    Dim I As Long
    
'سطر لتنشيط أو تحديد ورقة العمل الهدف
    Sheets(2).Activate
    On Error Resume Next
'تعيين المتغير ليساوي السلسلة النصية بعد علامة يساوي
    MSG = "هل أنت متأكد؟"
'[Yes - No] تعيين المتغير ليساوي قيمة النقر على أحد الاختيارين
    ANS = MsgBox(MSG, vbYesNo)
'إذا كانت الإجابة بنعم يتم تنفيذ الأسطر التالية
    If ANS = vbYes Then
'تعيين المتغير من النوع سلسلة نصية ليساوي عنوان الخلية في العمود الأول للبيان الذي تم النقر عليه
        Zouh = ListBox1.List(ListBox1.ListIndex, 5)
'تعيين المتغير ليساوي ورقة العمل الهدف
        Set MYSH = Sheets(2)
'بدء التعامل مع ورقة العمل
        With MYSH
'تحديد الخلية للمتغير المشار إليه
            .Application.Range(Zouh).Activate
'قيمة الخلية نفسها وهنا لا تتم عملية الإزاحة لأنها نقطة البداية وتساوي مربع النص الأول
            .Range(Zouh).Offset(0, 0).Value = TextBox1.Value
'تتم عملية الإزاحة بمقدار عمود واحد وتساوي مربع النص الثاني
            .Range(Zouh).Offset(0, 1).Value = TextBox2.Value
'تتم عملية الإزاحة بمقدار عمودين وتساوي مربع النص الثالث
            .Range(Zouh).Offset(0, 2).Value = TextBox3.Value
'تتم عملية الإزاحة بمقدار ثلاثة أعمدة وتساوي مربع النص الرابع
            .Range(Zouh).Offset(0, 3).Value = TextBox4.Value
        End With
    End If
'حلقة تكرارية لمسح مربعات النصوص الأربعة بعد ترحيل البيانات
    For I = 1 To 4
        Me.Controls("TextBox" & I).Text = ""
    Next I
'إغلاق الفورم بشكل مؤقت
    Unload Me
'إظهار الفورم
    UserForm1.Show
'إخفاء مربع القائمة
    ListBox1.Visible = False
End Sub

Private Sub ListBox1_Click()
'[ListBox1] يتم تنفيذ الإجراء في حالة النقر داخل
'----------------------------------------------
'في حالة حدوث خطأ يتم إنهاء الإجراء الفرعي
    On Error GoTo 1
    Dim MYSH As Worksheet, Zouh As String
'تعيين المتغير من النوع سلسلة نصية ليساوي عنوان الخلية في العمود الأول للبيان الذي تم النقر عليه
    Zouh = ListBox1.List(ListBox1.ListIndex, 5)
'تعيين المتغير ليساوي ورقة العمل الهدف
    Set MYSH = Sheets(2)
'بدء التعامل مع ورقة العمل
    With MYSH
'تحديد الخلية للمتغير المشار إليه
        Application.Range(Zouh).Activate
'مربع النص الأول يساوي نطاق الخلية المشار إلى عنوانها
        TextBox1.Text = .Range(Zouh).Value
'مربع النص الثاني يساوي الخلية المجاورة بمقدار عمود واحد
        TextBox2.Text = .Range(Zouh).Offset(0, 1).Value
'مربع النص الثالث يساوي الخلية المجاورة بمقدار عمودين
        TextBox3.Text = .Range(Zouh).Offset(0, 2).Value
'مربع النص الرابع يساوي الخلية المجاورة بمقدار ثلاثة أعمدة
        TextBox4.Text = .Range(Zouh).Offset(0, 3).Value
    End With
1 End Sub

Private Sub UserForm_Initialize()
'ينفذ هذا السطر عند تشغيل الفورم ويقوم بإخفاء الإطار بما في داخله من أدوات
'-------------------------------------------------------------------------
    Frame1.Visible = False
End Sub

وزيادة في الخير أرفق لك الملف به الكود مشروح ربما لا تحب أن تقرأ الشرح في المنتدى وتقرأه من داخل محرر الأكواد

لا تنسانا بدعوة بظهر الغيب

 

تقبل الله منا ومنكم :fff::gift2: :gift2: :fff:

Add Edit Call UserForm Zuhair.rar

  • Like 3
رابط هذا التعليق
شارك

الأخ ياسر والأخ زوهير، أنتما مثالان كبيران حقا للعطاء والخير، بارك الله فيكما وغفر الله لكما ورزقتما الجنة بدون سابقة عذاب

تم تعديل بواسطه شكيب عمار
  • Like 2
رابط هذا التعليق
شارك

الاخ ياسر اخي الكريم جزاك الله خيرا

ولله كل من فضلكم     -   منكم اخذنا ولم تبخلوا علينا بالعطاء جزاكم الله عنا خير الجزاء 

شرح ولا اروع لو كنت كنت انامن شرح لم شرحته بهذه الكفاءة

الاخ شكيب عمار

دعاءك لنا تشيجيع اكثر واكثر جزاك الله خيرا

  • 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