تعلم واقرأ وارتقِ
[img]فورم  ترحيل بيانات من داخل الاكسل Uoou910[/img]
تعلم واقرأ وارتقِ
هل تريد التفاعل مع هذه المساهمة؟ كل ما عليك هو إنشاء حساب جديد ببضع خطوات أو تسجيل الدخول للمتابعة.

تعلم واقرأ وارتقِ


 
الرئيسيةالبوابةالتسجيلدخول
غفرانك ربنا واليك المصير
رب زدني علما
سجل بالمنتدى ليظهر لك باقى المواضيع المهمه
سبحانك لا علم لنا إلا ما علمتنا أنك أنت العليم
علم اولادك برياض الأطفال والصفوف الأولى من التعليم الابتدائى
مجدى يونس ببورسعيد
أهلا بك من جديد يا زائر آخر زيارة لك كانت في
آخر عضو مسجل arabicnet فمرحبا به

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

 

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

اذهب الى الأسفل 
كاتب الموضوعرسالة
مجدى يونس
Admin
مجدى يونس

عدد المساهمات : 1428
تاريخ التسجيل : 17/05/2012
الموقع : محافظة بورسعيد

فورم  ترحيل بيانات من داخل الاكسل Empty
مُساهمةموضوع: فورم ترحيل بيانات من داخل الاكسل   فورم  ترحيل بيانات من داخل الاكسل Icon_minitimeالسبت أكتوبر 05, 2019 7:56 am

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


الفيديو





الكود





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

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك
من أحب الله رأى كل شئ جميلا
مع تحياتى مجدى يونس
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdiyonis1.forumegypt.net
 
فورم ترحيل بيانات من داخل الاكسل
الرجوع الى أعلى الصفحة 
صفحة 1 من اصل 1

صلاحيات هذا المنتدى:لاتستطيع الرد على المواضيع في هذا المنتدى
تعلم واقرأ وارتقِ :: تعلم الاكسل-
انتقل الى: