أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
ashraf_hertlion hassona229-- لا تميز خلال هذه الفترة YasserKhalil مطلوب تعديل الكود للطباعة اكسيل اسئله واجابات


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





تعديل على بعض الأكواد

السلام عليكم إخوتي أتمنى تكونوا إن شاء الله بخير أنا عملت في الملف المرفق قي شيت DATA ELV نموذج إدخال بيانات يرحل إ ..


موضوع مغلق


10-11-2021 11:54 صباحا
ayoub2007
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-11-2017
رقم العضوية : 1867
المشاركات : 160
الجنس : ذكر
تاريخ الميلاد : 23-12-1970
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 106
 offline 

السلام عليكم إخوتي 



أتمنى تكونوا إن شاء الله بخير 



أنا عملت في الملف المرفق قي شيت DATA ELV نموذج إدخال بيانات  يرحل إلى قاعدة بيانات في نفس الشيت و عملت أكواد إضافة تعديل حذف  بحث و استعلام (منقولة عن بعض الأساتذة جزاهم الله خيرا)



أولا عندما أضيف بيانات تلميذ جديد البيانات لا تضاف مباشرة في أخر سطر بل تترك عدة أسطر فارغة 



زر البحث و الاستعلام  لا يعمل 



أطلب المساعدة و شكرا

 
 
  مشروع.xlsm   تحميل xlsm مرات التحميل :(8)
الحجم :(508.358) KB



أفضل إجابة مقدمة من ابراهيم الحداد وهي:
السلام عليكم و رحمة الله
يمكنك استخدام هذا الكود لادراج التلاميذ الجدد
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim LR As Long, x As Integer, y As Integer
Dim Arr As Variant, temp As Variant
Set ws = Sheets("DATA ELV")
x = WorksheetFunction.CountA(ws.Range("C4:C10"), _
ws.Range("F4:F10"), ws.Range("K4:K10"))
y = 21 - x
If y > 0 Then
MsgBox "يوجد " & y & " بيانات ناقصة"
Exit Sub
Else

LR = ws.Range("C" & Rows.Count).End(3).Row + 1

Arr = Array("C4", "C5", "C6", "C7", "C8", "C9", "C10", _
             "F4", "F5", "F6", "F7", "F8", "F9", "F10", _
             "K4", "K5", "K6", "K7", "K8", "K9", "K10")
For i = LBound(Arr) To UBound(Arr)
ws.Range("C" & LR).Offset(, i) = ws.Range(Arr(i))
ws.Range(Arr(i)) = ""
Next
End If

End Sub
عرض الإجابة




10-11-2021 01:21 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل على بعض الأكواد
وعليكم السلام أخي الكريم
يرجى عدم رفع الملف الأصلي الذي تعمل عليه .وقم بتصميم ملف بسيط فيه أوراق العمل المطلوب العمل عليها فقط ، وإزالة الصفوف الغير ضرورية مع الإبقاء على 20 صف فقط لتجربة الأكواد 
والرجاء توضيح التفاصيل وأوراق العمل المطلوب عليها ، ويكون الموضوع مركز في مشكلة واحدة فقط مع وضع المحاولات التي حاولتها للوصول للحل وشرح المشكلة التي قابلتك ، فالمنتدى تعليمي في المقام الاول لذا هدفنا الارتقاء بمستوى الاعضاء.

10-11-2021 03:17 مساء
مشاهدة مشاركة منفردة [2]
ayoub2007
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-11-2017
رقم العضوية : 1867
المشاركات : 160
الجنس : ذكر
تاريخ الميلاد : 23-12-1970
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 106
 offline 
look/images/icons/i1.gif تعديل على بعض الأكواد
ورقة العمل DATA ELV
زر تلميذ جديد لا  يرحل البيانات إلى السطر المطلوب أي بعد أخر صف فية بيانات
زر البحث و الاستعلام لا يفي بالطلب من أجل تنفيد الأزرار المتبقية (زر الحذف و زر التعديل)
 
 
  - Copie.xlsm   تحميل xlsm مرات التحميل :(11)
الحجم :(58.046) KB


11-11-2021 12:00 صباحا
مشاهدة مشاركة منفردة [3]
ابراهيم الحداد
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 237
الجنس : ذكر
الدعوات : 4
يتابعهم : 0
يتابعونه : 34
قوة السمعة : 2349
عدد الإجابات: 31
 offline 
look/images/icons/i1.gif تعديل على بعض الأكواد
السلام عليكم و رحمة الله
يمكنك استخدام هذا الكود لادراج التلاميذ الجدد
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim LR As Long, x As Integer, y As Integer
Dim Arr As Variant, temp As Variant
Set ws = Sheets("DATA ELV")
x = WorksheetFunction.CountA(ws.Range("C4:C10"), _
ws.Range("F4:F10"), ws.Range("K4:K10"))
y = 21 - x
If y > 0 Then
MsgBox "يوجد " & y & " بيانات ناقصة"
Exit Sub
Else

LR = ws.Range("C" & Rows.Count).End(3).Row + 1

Arr = Array("C4", "C5", "C6", "C7", "C8", "C9", "C10", _
             "F4", "F5", "F6", "F7", "F8", "F9", "F10", _
             "K4", "K5", "K6", "K7", "K8", "K9", "K10")
For i = LBound(Arr) To UBound(Arr)
ws.Range("C" & LR).Offset(, i) = ws.Range(Arr(i))
ws.Range(Arr(i)) = ""
Next
End If

End Sub



الكلمات الدلالية
تعديل ، الأكواد ،


 










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

الساعة الآن 06:37 مساء