تعديل و نقل

[محمد عدنان]

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

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

Private Sub CommandButton2_Click()
    On Error GoTo Error
    If Txtname1 = "" Then
        MsgBox ("أدخل نص في حقل البحث")
    Else
        Cells.Find(What:=TextBox1, After:=ActiveCell, LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Font.Color = vbRed
        Application.Wait (Now + TimeValue("0:00:02"))
        ActiveCell.Font.Color = vbBlack
    End If

    Exit Sub
Error:
    MsgBox ("لا تتوفر نتائج للبحث")
End Sub

Private Sub ListBox4_Click()
    Txtname1.Value = ListBox4.Value
End Sub

Private Sub Txtname1_Change()
    Dim X As Long, Cell As Range
    ListBox4.clear
    For Each Cell In Range("A6:Aw77" & Cells(Rows.Count, 1).End(xlUp).Row)
        X = InStr(1, Cell.Value, Txtname1.Text)
        If X > 0 Then
            ListBox4.AddItem Cell
            MsgBox Cell
        End If
    Next Cell
End Sub

كشوفات الطلبة الرسمي 2022 - 1.xlsm

[حسين مامون]

بالنسبة لاضافة طالب انسخ الكود الى الفورم

Option Explicit
Private Sub Comclass_Change()
Label13.Caption = Comclass.Column(1)
Label14.Caption = Comclass.Column(2)

End Sub

Private Sub CommandButton1_Click()
'On Error Resume Next
Dim x
Dim R As Long
 Dim RR, lr
If Label13.Caption = "" Then MsgBox "اختر الصف اولا", vbExclamation: Exit Sub
R = Label13.Caption
RR = Label14.Caption
Dim ws As Worksheet: Set ws = Sheets("Names")
Application.ScreenUpdating = False
lr = ws.Cells(Rows.Count, (R)).End(3).Row
ws.Range(RR).Offset(lr) = txtname



Application.ScreenUpdating = True

End Sub

Private Sub UserForm_Click()
End Sub

Private Sub UserForm_Initialize()
Dim x, R
R = 0

Dim ws As Worksheet: Set ws = Sheets("Names")
Comclass.ColumnCount = 3
For x = 1 To 49
If ws.Cells(1, x) = "الرقم" Then GoTo 1
Comclass.AddItem
Comclass.List(R, 0) = ws.Cells(1, x)
Comclass.List(R, 1) = ws.Cells(1, x).Column
Comclass.List(R, 2) = ws.Cells(1, x).Address

R = R + 1


1: Next x

End Sub

 

[محمد عدنان]

السلام عليكم 

اخ @حسين مامون الله يعطيك العافية لكن الكود لا يعمل  يظهر الخطأ

[حسين مامون]

يعمل عندي وهذا المرفق

كشوفات الطلبة الرسمي 2022 - 1.xlsm

سبب الخطأ في الصورة    امسح المدى الخاص بتعبأة الكومبوبومسات

[محمد عدنان]

اشكرك اخوي @حسين مامون جزء الاضافة يعمل بشكل جيد  لكن جزء البحث هل يوجد تعديل على الكود؟

[حسين مامون]

لم اتوصل بعد للحل بخصوص البحث 

ان اردة يمكن اضافة كومبوبوكس لتحديد عمود البحث......... وهكذا سينجح البحث في شعبة واحدة .... ان اعجبك رد علي وسأعمل عليه

[محمد عدنان]

هل عن طريق الكومبو بكس بمكن اظهار اسماء الشعبة الواحدة في الليست بوكس ؟ الجزء الثالث اظهار اسماء طلاب الشعبة و عددها

[حسين مامون]

الكومبوبوكس لتعيين العمود لي فيه اسماء الطلاب 

يعني عند ادخال اسم الطالب في تيكست البحث سيظهر اسم الطالب في الست1

ويمكن بحث في جميع الاعمدة ولكن بالحلقات التكرارية  او انشاء صفحة مساعدة  اصبر شويا وسأعمل على هذا  ...جرب المرفق

كشوفات الطلبة الرسمي 2022 - 1.xlsm

[محمد عدنان]

السلام عليكم 

الاستاذ الكبير @حسين مامون جزاك الله كل خير  و الله يعطيك العافية البرنامج يعمل بشكل جيد 100% 

كل الاحترام و التقدير لك 

ملاحظة هل يمكن بعد عملية البحث  وضع زر لحذف السطر المظلل و يقوم بحذفها من الشيت 

اكرر شكري لك  في ميزان حسناتك 

[حسين مامون]

الحمد لله ان تم الامر على خير

تم عمل المطلوب  جرب المرفق

كشوفات الطلبة الرسمي 2022 - 1.xlsm

[محمد عدنان]

السلام  عليكم ..تم المساعدة به من قبل الاستاذ الكبير @حسين مامون   و له و لكم  كل الاحترام  و التقدير ..هل بالامكان العديل على الملف كالاتي 

1. ماكرو لتعديل اسم الطالب او الصف و الشعبة  مع ملاحظة اذا تم تغير الصف و الشعبة يقوم بتقل الاسم الى الصف و الشعبة الجديدة مع حذف القديم

2. ماكرو  يقوم بعد حذف اسم الطالب  يقوم بترحيل الاسم و الصف و الشعبة  الى شيت delete table  بالاضافة الى يوم و تاريخ الحذف او النقل ..و لكم جزيل الشكر 

student2022.xlsm