كتابة بيانات مختلفة في عدة صفحات اكسيل من خلال يوزر فورم واحدةة

[زياد عبد الجليل]

السلام عليكم الى كل باحث و خبير ارجو المساعدة :

كيف يمكن من خلال يوزر فورم واحدة ان اكتب بيانات في صفحة اكسيل 1 ثم اكتب بيانات اخرى مختلفة من خلال نفس اليوزر فورم في الصفحة 2 

[ياسر خليل أبو البراء]

بالمثال يتضح المقال ..ارفق ملفك للتوضيح

[زياد عبد الجليل]

السلام عليكم 

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

وشششككككككررررررررررررررا لكل من ساعدني

 

كتابة قوائم الطلبة من خلال فورم واحد.rar

[زياد عبد الجليل]

بارك الله فيك اخي ياسر سافعل ان شاء الله و الله اشتقنا للاستاذ ربيع

[شوقي ربيع]

السلام عليكم

لتعبئة الكبوبوكس باسماء الشيتات الموجودة في الملف

Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Me.ComboBox1.AddItem ws.Name
Me.ComboBox2.AddItem ws.Name
Next

لتسجيل بيانات جديدة على حسب الشيت المختار من الكمبوبوكس

Dim ws As Worksheet
If Me.ComboBox1 = "" Then Exit Sub
Dim sName As String: sName = Me.ComboBox1.Value
Set ws = ThisWorkbook.Sheets(sName)
Dim iRow As Long: iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim i As Byte

        If Trim(Me.TextBox1.Value) = "" Then
        Me.TextBox1.SetFocus
        MsgBox "ÑÌÇÁ ÇãáÇÁ ßá ÇáÎÇäÇÊ ÇáÎÇÕÉ ÈÈíÇäÇÊ ÇáãæÙÝ", vbOKOnly, "ÊÓÌíá ãæÙÝ"
        Exit Sub
        End If
        
        For i = 1 To 4
        ws.Cells(iRow, i).Value = Me("TextBox" & i).Value
        Me("TextBox" & i).Value = ""
        Next

كود البحث عبر لقب الطالب

     d = UCase(Me.TextBox5) & "*"
     e = 0
     On Error GoTo Err
1        For i = LBound(keyArray) To UBound(keyArray)
            If UCase(keyArray(i, 2)) Like d Then
                e = e + 1: ReDim Preserve itemArray(1 To 4, 1 To e)
                itemArray(1, e) = keyArray(i, 1)
                itemArray(2, e) = keyArray(i, 2)
                itemArray(3, e) = keyArray(i, 3)
                itemArray(4, e) = keyArray(i, 4)
            End If
        Next i
      
        If e > 0 Then
            If UBound(itemArray, 2) > 1 Then
                Me.ListBox1.List = Application.Transpose(itemArray)
                Else
                Dim c(1 To 1, 1 To 4)
                c(1, 1) = itemArray(1, 1)
                c(1, 2) = itemArray(2, 1)
                c(1, 3) = itemArray(3, 1)
                c(1, 4) = itemArray(4, 1)
                Me.ListBox1.List = c
            End If
        Else
                Me.ListBox1.Clear
        End If
Exit Sub
Err:
Dim ws As Worksheet
Dim sName As String: sName = Me.ComboBox2.Value
Set ws = ThisWorkbook.Sheets(sName)
Dim iRow As Long: iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

  keyArray = ws.Range("A3:B" & lrw).Value
GoTo 1

كود التعديل على البايانات

Dim iRow As Long: iRow = Me.TextBox6.Value + 2
Dim ws As Worksheet
Dim sName As String: sName = Me.ComboBox2.Value
Set ws = ThisWorkbook.Sheets(sName)

ws.Cells(iRow, 1).Value = TextBox6.Value
ws.Cells(iRow, 2).Value = TextBox7.Value
ws.Cells(iRow, 3).Value = TextBox8.Value
ws.Cells(iRow, 4).Value = TextBox9.Value

تحياتي للجميع

 

كتابة قوائم الطلبة من خلال فورم واحد.rar

[طلعت محمد حسن]

السلام عليكم

كل الشكر والاحترام للاستاذ شوقي ربيع على هذه المعلومات القيمة ولاثراء الموضوع كانت لي هذه المحاوله

كتابة قوائم الطلبة من خلال فورم واحد.rar

[زياد عبد الجليل]

السلام عليكم استاذ شوقي بارك الله فيك والله عمل ممتاز الأن عرفت ما كان  ينقصني في الكود :وهو 

Dim sName As String: sName = Me.ComboBox1.Value
Set ws = ThisWorkbook.Sheets(sName

المهم يا عملاق البرمجة بارك الله فيك 

ولكن أرجو تعديل كود زر التعديل فلازال المشكل فيمكن تعديل كل البيانات ما عدا رقم التسجيل المهم عمل ممتاز علامتك 40/40 مممممممتتتتتتتتتتتتتتتتتتتتتتتتتتااااااااااااااااااااااااززززززززززززززز يا عملاق الجزائر

[شوقي ربيع]

كود التعديل شغال

ربما انت تنفذ على ملف اخر

لذى يجب ان تفهم اني اعتمدت في كود التعديل على رقم الطالب

كما تلاحظ هنا

Dim iRow As Long: iRow = Me.TextBox6.Value + 2

بعتبار ان المتغير iRow  هو سطر التعديل انا اضفت له رقم 2 ليتناسب مع السطر الفعلي الذي يحتوى البيانات لان السطر الذي تبدء منه البانات هو السطر الثالث في الشيت

انت عدل حسب السطر الذي تبدا منه البيانات في الملف لديك مثلا لو البايانات تبدء من السر الرابع اضف 3 وهكذا

[زياد عبد الجليل]

السلام عليكم استاذ طلعت 

بارك الله فيك و الله عملك دقيق وممتاز كذلك يرتقي الى مستوى عمل الاستاذ شوقي بارك الله فيك اللهم اجعلها في ميزان حسناتهما يارب امييييييييييييييييييييننننننننننننننننننننن

[طلعت محمد حسن]

السلام عليكم استاذ طلعت 

بارك الله فيك و الله عملك دقيق وممتاز كذلك يرتقي الى مستوى عمل الاستاذ شوقي بارك الله فيك اللهم اجعلها في ميزان حسناتهما يارب امييييييييييييييييييييننننننننننننننننننننن

بارك الله فيك اخي العزيز على كلماتك الرائعه ولكن اخي الكريم انا طالب في مدرسه الاستاذ شوقي ربيع فكل يوم اتعلم منه الكثير جزاه الله خير على ما يقدمه لنا من علم ومعرفه.

[زياد عبد الجليل]

شكرا على ردك استاذ شوقي نعم يقوم بالتعديل ولكن ليس في نفس سطر تواجد البيانات اي انني بعد تعديل اللقب او الاسم او تاريخ الميلاد فان الكود يعمل بشكل جيد و لكن عند تعديل رقم التسجيل هنا تكمن المشكلة أي بعد كتابة رقم تسجيل وتعديله و الضغط على زر التعديل يسجلها كبيان جديد ويسجلها في الصف 8 جربته على ملفك المرفق  

لا ادري ربما فهمتك خطأ فانا اود تعديل كل البيانات بما فيها رقم التسجيل مع بقاء البيانات في مكانها دون ان تنزل أو تصعد 

شكرا جزيلا

[شوقي ربيع]

 

السلام عليكم استاذ طلعت 

بارك الله فيك و الله عملك دقيق وممتاز كذلك يرتقي الى مستوى عمل الاستاذ شوقي بارك الله فيك اللهم اجعلها في ميزان حسناتهما يارب امييييييييييييييييييييننننننننننننننننننننن

بارك الله فيك اخي العزيز على كلماتك الرائعه ولكن اخي الكريم انا طالب في مدرسه الاستاذ شوقي ربيع فكل يوم اتعلم منه الكثير جزاه الله خير على ما يقدمه لنا من علم ومعرفه.

 

كلنا طلبة في هذا الصرح العملاق

جزاك الله خيرا اخي طلعت

[شوقي ربيع]

جرب هذا الكود للتعديل

لاكن ممكن يكون ثقيل في حالة كثرة البيانات

Dim iRow As Long: iRow = Me.TextBox6.Value + 2
Dim ws As Worksheet
Dim sName As String: sName = Me.ComboBox2.Value
Set ws = ThisWorkbook.Sheets(sName)
Dim lLrw As Long, lRw As Long: lRw = 3
Dim ii As Long: ii = Me.TextBox6.Value

Dim rRng As Range

With ws
        lLrw = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        For Each rRng In ws.Range("A3:A" & lLrw)
            If ii = rRng.Value Then
                .Cells(lRw, 1).Value = TextBox6.Value
                .Cells(lRw, 2).Value = TextBox7.Value
                .Cells(lRw, 3).Value = TextBox8.Value
                .Cells(lRw, 4).Value = TextBox9.Value
            Exit For
            End If
         lRw = lRw + 1
        Next
End With

[زياد عبد الجليل]

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

[ا بو سليمان]

اضافه الى الابداع في الاجابه 

 

ابداع في الاخلاق والاسلوب الرائع في الحوار 

 

فعلا مدرسة اوفسينا  ليست مدرسة معادلات فقط  بل مدرسة  داخل اسرة متحااااااااااابه