اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

الاخوة الافاضل اتمنى تكونوا بخير

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

 

ارجو المساعدة للاهمية 

شاكر ومقدر

بسم الله.xlsm

  • Foksh changed the title to المساعدة بكود تفعيل الازرار الموجودة بالملف
قام بنشر

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

قام بنشر

السلام عليكم

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

Sub AddEmployee()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim nextRow As Long, i As Long
    Dim srcRange As Variant
    
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    If ws1.Range("I9").Value = "" Then
        MsgBox "يرجى إدخال اسم الموظف!", vbExclamation, "تنبيه"
        Exit Sub
    End If
    
    nextRow = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row + 1
    
    srcRange = Array("I5", "I7", "I9", "I11", "I13", "L11", "L13", "I15", "L15", _
                     "L5", "L7", "L9", "I19", "L19", "I21", "L21", "I23", "L23", _
                     "I25", "L25", "I28", "L28", "L30", "I33", "L33", "I35", "L35", _
                     "I37", "I40", "L40", "I44", "L44", "I46", "L46", "I48", "L48", _
                     "I50", "L50", "I52", "L52", "L55")
    
    For i = LBound(srcRange) To UBound(srcRange)
        ws2.Cells(nextRow, i + 1).Value = ws1.Range(srcRange(i)).Value
    Next i
    
    MsgBox "تمت إضافة الموظف بنجاح!", vbInformation, "نجاح"
End Sub

 

بسم الله.xlsm

  • Like 4

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

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information