فورم ترحيل بيانات من داخل الاكسل

فورم ترحيل بيانات من داخل الاكسل

الفيديو

الكود

Option Explicit

Function ValidateForm() As Boolean

    txtName.BackColor = vbWhite
    cmbQualification.BackColor = vbWhite
    txtCity.BackColor = vbWhite
    txtState.BackColor = vbWhite
    txtCountry.BackColor = vbWhite

    ValidateForm = True

    If Trim(txtName.Value) = "" Then

        MsgBox "لا يمكن ترك الاسم فارغًا.", vbOKOnly + vbInformation, "Name"
        txtName.BackColor = vbRed
        txtName.Activate
        ValidateForm = False
    ElseIf optMale.Value = False And optFemale.Value = False Then

        MsgBox "يرجى اختيار النوع.", vbOKOnly + vbInformation, "Sex"
        ValidateForm = False

    ElseIf cmbQualification.Text <> "ثانوى عام" And cmbQualification.Text <> "فنى صناعى" And _
            cmbQualification.Text <> "بكلاريوس" And cmbQualification.Text <> "ماجستير" And _
            cmbQualification.Text <> "الدكتوراه" Then
        MsgBox "يرجى تحديد المؤهل الصحيح من القائمة المنسدلة.", vbOKOnly + vbInformation, "المؤهل"
        cmbQualification.BackColor = vbRed
        cmbQualification.Activate
        ValidateForm = False
    ElseIf Trim(txtCity.Value) = "" Then
        MsgBox "لا يمكن ترك المدينة فارغًا.", vbOKOnly + vbInformation, "City name"
        txtCity.BackColor = vbRed
        txtCity.Activate
        ValidateForm = False

    ElseIf Trim(txtState.Value) = "" Then
        MsgBox " لا يمكن ترك الشارع فارغا.", vbOKOnly + vbInformation, "State Name"
        txtState.BackColor = vbRed
        txtState.Activate
        ValidateForm = False
    ElseIf Trim(txtCountry.Value) = "" Then
        MsgBox "لا يمكن ترك الدولة فارغًا.", vbOKOnly + vbInformation, "Country Name"
        txtCountry.BackColor = vbRed
        txtCountry.Activate
        ValidateForm = False
    End If

End Function

Function Reset()

    Application.ScreenUpdating = False

    txtName.Value = ""
    txtName.BackColor = vbWhite

    optMale.Value = False
    optFemale.Value = False

    cmbQualification.Text = ""
    cmbQualification.BackColor = vbWhite

    txtCity.Value = ""
    txtCity.BackColor = vbWhite

    txtState.Value = ""
    txtState.BackColor = vbWhite

    txtCountry.Value = ""
    txtCountry.BackColor = vbWhite

    Application.ScreenUpdating = True


End Function

Private Sub cmbQualification_Change()

End Sub

Private Sub cmdReset_Click()

    Dim i As Integer

    i = MsgBox("هل تريد مسح البيانات لاعادة تسجيل البيانات?", vbQuestion + vbYesNo + vbDefaultButton2, "Form Reset")

    If i = vbYes Then

        Call Reset

    End If

End Sub

Private Sub cmdSave_Click()

    Application.ScreenUpdating = False

    Dim iRow As Long

    iRow = Sheets("Data").Range("A1048576").End(xlUp).Row + 1

    If ValidateForm = True Then

        With ThisWorkbook.Sheets("Data")

           .Range("A" & iRow).Value = iRow - 1
           .Range("B" & iRow).Value = txtName.Value
           .Range("C" & iRow).Value = IIf(optMale.Value = True, "ذكر", "انثى")
           .Range("D" & iRow).Value = cmbQualification.Text
           .Range("E" & iRow).Value = txtCity.Value
           .Range("F" & iRow).Value = txtState.Value
           .Range("G" & iRow).Value = txtCountry.Value

        End With
        Call Reset
    Else
        Application.ScreenUpdating = True
        Exit Sub
    End If

        Application.ScreenUpdating = True

End Sub

Private Sub optFemale_Click()

End Sub

Private Sub optMale_Click()

End Sub

_________________

لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

من أحب الله رأى كل شئ جميلا

مع تحياتى مجدى يونس

» فورم ترحيل بيانات متفرقة وترحيل لشيت اخر وتعديل بيانات
» فورم ترحيل بيانات متفرقة وترحيل لشيت اخر وتعديل بيانات
» فورم ترحيل بيانات واستدعاء وحفظ صور
» فورم ترحيل بيانات عمودى وافقى
» فورم ترحيل بيانات الى الشيت المختار وطباعة البيانات