فورم هوايات وانشطة بالنادى مع ترتيب الاسماء

Private Sub ComboBox1_Change()
' الكود المستخدم في البحث عن البيانات
On Error Resume Next
' ورقة العمل الذي سوف يتم فيها البحث
sheet1.Activate
'  رقم صف بداية البحث

' العمود الذي سوف يتم فيه البحث عن البيانات
'  بما اننا سوف نبحث بدلالة الاسم والذي يقع غي العمود _
((A))
Do Until sheet1.Cells("A").Text = ""
    If ComboBox1.Text = sheet1.Cells("A").Text Then
        Cells("A").Activate
' الأسم وياخذ العمود صفر
TX1 = ActiveCell.Offset(0, 0).Text
' النوع- عمود1
TX2 = ActiveCell.Offset(0, 1).Text
'العمر- عمود2
TX3 = ActiveCell.Offset(0, 2).Text
'أسم الزوج / الزوجة-عمود3
TX4 = ActiveCell.Offset(0, 3).Text
'الجنسية
TX5 = ActiveCell.Offset(0, 4).Text
'الهويات
TX6 = ActiveCell.Offset(0, 5).Text
'الحالة الأجتماعية
If Me.TX4.Value = "" Then
TX9.Value = "اعذب"
Else
TX9.Value = "متزوج"
End If

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Exit Sub
        End If
       
Loop
''''''''''''''''''''''MsgBox ("!!! الرقم الذى ادخلته غير صحيح")
' مسح الفورم
Me.TX1 = ""
Me.TX2 = ""
Me.TX3 = ""
 Me.TX4 = ""
Me.TX5 = ""
Me.TX6 = ""
Me.TX7 = ""
Me.TX8 = ""
' مؤشر الماوس علي مربع نص الأسم
Me.TX1.SetFocus
End Sub

Private Sub CommandButton3_Click()
End Sub

Private Sub CommandButton4_Click()

End Sub

Private Sub CommandButton5_Click()
MultiPage1.Pages(0).Visible = True
MultiPage1.Pages(1).Visible = False
MultiPage1.Value = 0
Me.Height = 430
End Sub

Private Sub CommandButton6_Click()
Unload Me
End Sub

Private Sub CommandButton7_Click()
MultiPage1.Pages(0).Visible = False
MultiPage1.Pages(1).Visible = True
MultiPage1.Value = 1
Me.Height = 350
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub L_DateH_Click()

End Sub

Private Sub lstAge_Click()

End Sub

Private Sub SpinButton1_Change()

End Sub

Private Sub MultiPage1_Change()

End Sub

Private Sub TX2_Change()

End Sub

Private Sub TX4_Change()

End Sub

Private Sub TX9_Change()

End Sub

Private Sub UserForm_Activate()
MultiPage1.Pages(0).Visible = True
MultiPage1.Value = 0
Me.Height = 430
End Sub

Private Sub UserForm_Initialize()
' تعيين خصائص عناصر التحكم على تهيئة UserForm. _
يحصل على تحميل في UserForm على النقر فوق زر الأمر على ورقة العمل والذي يستخدم في _
UserForm عرض الأسلوب.
Dim i As Integer
Dim myArray As Variant
'وحدات السن الذي سوف تضاف الي صندوق القائمة "الليست بوكس
With Me.lstAge
For i = 20 To 60
.AddItem i
Next i

End With

'اضافة العناصر الي الكمبو بوكس
myArray = Array("مصـر", "السودان", "الأردن", "سوريا", "اليمن", "لبنان", _
"الجزائر", "تونس", "المغرب", "السعودية", "الصومال", "الفلبين", "باكستان", "الهند", _
"أندونيسيا", "بنجلاديش", "تركيا")
Me.cmbCountry.List = myArray

Me.txtSpouse.Enabled = False

' جميع _
OptionButtons _
ضمن اسم مجموعة محددة تصبح يستبعد بعضها بعضا ومكتفية ذاتيا ضمن تلك المجموعة ولا تؤثر على اختيار _
OptionButtons _
خارج تلك المجموعة
''اختيار _
OptionButton _
في مجموعة واحدة وازالة اختيار كل _
OptionButtons _
أخرى من تلك المجموعة فقط.
' تسمية مجموعة لادارة _
OptionButtons _
اولا : ادارة مجموعة اختيار النوع

optMale.GroupName = "النوع"
optFemale.GroupName = "النوع"

'  ادارة مجموعة تاريخ الاشتراك

Me.Caption = "مع تحيات مجدى يونس"
End Sub
 
Private Sub clearForm()
'لمسح الفورم
txtName.Value = ""
'الأسم
optMale.Value = False
'تحديد النوع - ذكر
optFemale.Value = False
'تحديد النوع - انثي
lstAge.ListIndex = -1
'صندوق القائمة
cmbCountry.Value = ""
'البلد
chkReading.Value = False
'الهوايات - القراءة
chkMusic.Value = False
'الموسيقي
chkMovies.Value = False
'الأفلام
chkSports.Value = False
'الرياضة
chkMarried.Value = False
'متزوج / متزوجة
txtSpouse.Value = ""
End Sub
 
Private Sub Calendar1_Click()
End Sub
 
Private Sub chkMarried_Click()
'عند اختيار الحالة الاجتماعية تمكين اوعدم تمكين مربع النص (اسم الزوج / الزوجة

If chkMarried.Value = True Then
txtSpouse.Enabled = True
Else
txtSpouse.Enabled = False
End If

End Sub
 
 
 
Private Sub cmdClear_Click()

clearForm

End Sub
 
Private Sub cmdClose_Click()
Unload Me
End Sub
 Private Sub cmdSave_Click()
'حفظ البيانات في الشيت
' تعريف المتغيرات
Dim totalrows As Long
Dim str As String
Dim endDate As String, startDate As String
' سوف نقوم بادخال الشروط اذا كان احد الادخالات غير موجود يطالب المستخدم بتصحيح الادخال كالتالي
If txtName.Text = "" Then
MsgBox "من فضلك ادخل اسم المشترك", vbOKOnly, "الأسم خطأ!"
Exit Sub
ElseIf optMale.Value = False And optFemale.Value = False Then
MsgBox "من فضلك قم بتحديد النوع", vbOKOnly, "حدد النوع!"
Exit Sub
ElseIf lstAge.ListIndex = -1 Then
MsgBox "من فضلك اختار العمر", vbOKOnly, "حدد العمر!"
Exit Sub
ElseIf cmbCountry.Value = "" Then
MsgBox "من فضلك اختار البلد", vbOKOnly, "أختار البلد!"
Exit Sub
ElseIf chkReading.Value = False And chkMusic.Value = False And chkMovies.Value = False And chkSports.Value = False Then
MsgBox "أختر الهوايات", vbOKOnly, "ادخل الهوايات!"
Exit Sub
ElseIf chkMarried.Value = True And txtSpouse.Text = "" Then
MsgBox "أدخل اسم الزوج أو الزوجة", vbOKOnly, "الحالة الأجتماعية!"
Exit Sub

End If



'شيت الادخالات شيت رقم 1 العمود _
A
' حدد اول خلية فارغة
totalrows = sheet1.Cells(Rows.Count, "A").End(xlUp).Row
' عدد الصفوف العلوية
If totalrows < 3 Then
totalrows = 3
Else
totalrows = totalrows
End If

'الاسم
sheet1.Cells(totalrows + 1, 1) = txtName.Text
' النوع ذكر او انثي
If optMale.Value = True Then
sheet1.Cells(totalrows + 1, 2) = "ذكر"
ElseIf optFemale.Value = True Then
sheet1.Cells(totalrows + 1, 2) = "أنثي"
End If
' العمر
sheet1.Cells(totalrows + 1, 3) = lstAge.Value
' الحالة الجتماعية
If txtSpouse.Text <> "" Then
sheet1.Cells(totalrows + 1, 4) = txtSpouse.Text
Else
sheet1.Cells(totalrows + 1, 4) = "أعذب"
End If
' البلد
sheet1.Cells(totalrows + 1, 5) = cmbCountry.Value
' الهويات
If chkReading.Value = True Then
str = "القراءة, "
End If
If chkMusic.Value = True Then
str = str & "الموسيقي, "
End If
If chkMovies.Value = True Then
str = str & "الأفلام, "
End If
If chkSports.Value = True Then
str = str & "الرياضة, "
End If
'deleting comma and space, the 2 characters at the end of str
str = Left(str, Len(str) - 2)
sheet1.Cells(totalrows + 1, 6) = str
' ترتيب حسب الاسم
sheet1.Range("A4:H" & totalrows + 1).Sort Key1:=sheet1.Range("A4"), Order1:=xlAscending
'  بعد الانتهاء قم بمسح الفورم _
استدعاء

clearForm

End Sub



Sub Form_Clear()
Me.TX1 = ""
Me.TX2 = ""
Me.TX3 = ""
 Me.TX4 = ""
Me.TX5 = ""
Me.TX6 = ""
Me.TX7 = ""
Me.TX8 = ""
Me.ComboBox1 = ""

End Sub