اضافة البيانات في أكثر من شيت في ملف اكسل

**أبو إبراهيم الغامدي** · ديسمبر 18, 2020

في ١٥‏/١٢‏/٢٠٢٠ at 06:03, عفرنس said:

بمعنى ان بيانات شعبة 1و 5 ستكون في شيت 2

وبيانات شعبة 2و 6 ستكون في شيت 4

وبيانات شعبة 3و 7 ستكون في شيت 6

وبيانات شعبة 4و 8 ستكون في شيت 8

بحسب قالب البيانات في ورقة أكسل لا يمكن تطبيق الفكرة التي أشرت إليها أعلاه..

أنت بحاجة إلى إعادة نسخة تنسيق القالب ولصقه في الأسفل لتتمكن من إضافة الشعبة الثانية! ولا أظن أنه يوجد طريقة أخرى لتطبييق الفكرة..

وهناك إشكالية أخرى ؛ وهي طريقة تصفية البيانات التي تعمل بها في النموذج لا تسمح باختيار قيم متعددة!

**عفرنس** · ديسمبر 18, 2020

4 ساعات مضت, أبو إبراهيم الغامدي said:

بحسب قالب البيانات في ورقة أكسل لا يمكن تطبيق الفكرة التي أشرت إليها أعلاه..

أنت بحاجة إلى إعادة نسخة تنسيق القالب ولصقه في الأسفل لتتمكن من إضافة الشعبة الثانية! ولا أظن أنه يوجد طريقة أخرى لتطبييق الفكرة..

وهناك إشكالية أخرى ؛ وهي طريقة تصفية البيانات التي تعمل بها في النموذج لا تسمح باختيار قيم متعددة!

جزاك الله خيرا أخي الفاضل @أبو إبراهيم الغامدي على مرورك ..

هذا هو البرنامج وقوالب اكسل ..

** ملحوظة : كنت أضفت ماهو في المستطيل الأحمر المرفق في الصورة .. فأحيانا تنجح الطريقة وأحيانا أخرى لا تنجح ..

إليكم القوالب مرفقة ..

@Shivan Rekany

تجربة.rar

البرنامج.rar

تم تعديل ديسمبر 18, 2020 بواسطه عفرنس

أبو عبدالله الحلوانى · ديسمبر 18, 2020

أولا- باعتذر لتأخري بالرد فانا لا أزور الموقع الا بشكل متقطع هذه الأيام

ثانيا- لنصل الي الحل الذي يرضيك أعد النظر فيما قال أستاذنا أبو ابراهيم.

5 ساعات مضت, أبو إبراهيم الغامدي said:

بحسب قالب البيانات في ورقة أكسل لا يمكن تطبيق الفكرة التي أشرت إليها أعلاه..

ما هي الآلية التي ستضيف بها بيانات الشعبتين في الشيت الواحد هل ستكون اسماء الشعبة الأولي أولا ثم بيانات الشعبة الثانية تحتها بنفس الأعمدة أم سيتم تغير موضع ادخال كل شعبة

أوضح لنا هذه الجزئية لكي نستطيع المساعدة؟ كيف تريد أن يكون شكل بيانات الشعبتين داخل الشيت الواحد؟؟

**عفرنس** · ديسمبر 18, 2020

1 دقيقه مضت, أبو عبدالله الحلوانى said:

أولا- باعتذر لتأخري بالرد فانا لا أزور الموقع الا بشكل متقطع هذه الأيام

ثانيا- لنصل الي الحل الذي يرضيك أعد النظر فيما قال أستاذنا أبو ابراهيم.

ما هي الآلية التي ستضيف بها بيانات الشعبتين في الشيت الواحد هل ستكون اسماء الشعبة الأولي أولا ثم بيانات الشعبة الثانية تحتها بنفس الأعمدة أم سيتم تغير موضع ادخال كل شعبة

أوضح لنا هذه الجزئية لكي نستطيع المساعدة؟ كيف تريد أن يكون شكل بيانات الشعبتين داخل الشيت الواحد؟؟

أخي @أبو عبدالله الحلوانى حتى تتضح الصورة :

الان كل قالب اكسل يحوي 8 شيتات ..

وعندي كمثال مادة الرياضيات يدرسها معلمان .

المعلم الاول يدرس من شعبة 1 الى 4

المعلم الثاني يدرس من شعبة 5-8

كل معلم سأعطيه طلابه في ملف اكسل

فالمعلم الاول سيكون طلاب شعبة 1 في شيت رقم 2 وطلاب الشعبة 2 في شيت رقم 4 وهكذا شعبة3 في شيت 6 وطلاب شعبة 4 في شيت 8

_______

المعلم الثاني / اريد يكون طلاب شعبة 5 في شيت 2

وطلاب الشعبة 6 في شيت رقم 4 وهكذا شعبة 7 في شيت 6 وطلاب شعبة 8 في شيت 8

ان شاء الله اكون وضحت مرادي

**أبو إبراهيم الغامدي** · ديسمبر 18, 2020

3 دقائق مضت, أبو عبدالله الحلوانى said:

أوضح لنا هذه الجزئية لكي نستطيع المساعدة؟ كيف تريد أن يكون شكل بيانات الشعبتين داخل الشيت الواحد؟؟

أحسنت البيان أ. محمد..

وفي نظري أن بقاء كل شعبة في ورقة مستقلة أرتب للبيانات وأسهل في التعامل!

**ابو البشر** · ديسمبر 18, 2020

أخي فايز ...

المفروض كل شعب المعلم الواحد تكون مرتبطة بالمعلم نفسه من خلال علاقة يفهمها البرنامج .... حتى اذا كتبت الكود في التصدير للاكسل يبدأ بالمعلم س وينفذ تصدير كل شعبه بالترتيب الى ملف الاكسل ثم يبدأ بمعلم آخر وهكذا تكون العملية صحيحة في رأي الخاص .... بارك الله في الجميع

**عفرنس** · ديسمبر 18, 2020

9 دقائق مضت, أبو إبراهيم الغامدي said:

أحسنت البيان أ. محمد..

وفي نظري أن بقاء كل شعبة في ورقة مستقلة أرتب للبيانات وأسهل في التعامل!

أخي @أبو إبراهيم الغامدي

الأخ @أبو عبدالله الحلوانى استطاع ايجاد الحل للشعب من 1الى 4

بقي شعبة 5 الى 8 كنت أريدها بنفس الطريقة ..

**عفرنس** · ديسمبر 18, 2020

1 دقيقه مضت, ابو البشر said:

أخي فايز ...

المفروض كل شعب المعلم الواحد تكون مرتبطة بالمعلم نفسه من خلال علاقة يفهمها البرنامج .... حتى اذا كتبت الكود في التصدير للاكسل يبدأ بالمعلم س وينفذ تصدير كل شعبه بالترتيب الى ملف الاكسل ثم يبدأ بمعلم آخر وهكذا تكون العملية صحيحة في رأي الخاص .... بارك الله في الجميع

أخي @ابو البشر

البرنامج يتم استيراد البيانات اليه من خلال جدول الطلاب .

البيانات تشمل ( المستوى -الشعبة - والمادة - واسم الطالب ) وكل هذه مجتمعة في الجدول ..

أما أسماء المعلمين فهي مستقلة ولذلك تلاحظ انها في جدول مستقل ..

فمن الصعب اضافة كل معلم في الجدول

**أبو إبراهيم الغامدي** · ديسمبر 18, 2020

7 دقائق مضت, عفرنس said:

كل معلم سأعطيه طلابه في ملف اكسل

فالمعلم الاول سيكون طلاب شعبة 1 في شيت رقم 2 وطلاب الشعبة 2 في شيت رقم 4 وهكذا شعبة3 في شيت 6 وطلاب شعبة 4 في شيت 8

_______

المعلم الثاني / اريد يكون طلاب شعبة 5 في شيت 2

وطلاب الشعبة 6 في شيت رقم 4 وهكذا شعبة 7 في شيت 6 وطلاب شعبة 8 في شيت 8

أذن صار لكل معلم ملف خاص! هذا سهل.. سهل الله أمرك..

8 دقائق مضت, عفرنس said:

ان شاء الله اكون وضحت مرادي

الآن، نعم..

بعدها هذا التوضيح، لدي اقتراح فيما يتعلق بتصفية البيانات..

في اعتقادي أننا لسنا بحاجة إلى إنشاء جدول مؤقت لترحيل البيانات إلى أكسل! بل يمكن استخدام جدول الطلاب مباشرة!

المنهج CopyFromRecordset له محددان إضافيان هما عدد الأعمدة، وعدد الصفوف المطلوب جلب البيانات منها في مصدر السجل.. إذا أردنا مزيدا من التحكم..

**ابو البشر** · ديسمبر 18, 2020

1 دقيقه مضت, عفرنس said:

أخي @ابو البشر

البرنامج يتم استيراد البيانات اليه من خلال جدول الطلاب .

البيانات تشمل ( المستوى -الشعبة - والمادة - واسم الطالب ) وكل هذه مجتمعة في الجدول ..

أما أسماء المعلمين فهي مستقلة ولذلك تلاحظ انها في جدول مستقل ..

فمن الصعب اضافة كل معلم في الجدول

كلامك كله صيحيح لأنه يعمل على موقع نور ....

فيموقع نور يتم تصدير جداول المعلمين وجداول الطلاب ومنها يمكن الربط بين جداول الطلاب والمعلمين بطريقه تسهل عليك كا ما تريد فهله فيما بعد .... لكن طالما انك بدأت بطرقك هذه إذا لابد من البحث من مخرج ..... وقد تجد لها حل من الاخوة الخبراء ...

**عفرنس** · ديسمبر 18, 2020

7 دقائق مضت, أبو إبراهيم الغامدي said:

أذن صار لكل معلم ملف خاص! هذا سهل.. سهل الله أمرك

هذا صحيح ..

كل معلم له ملف مستقل ..

**أبو إبراهيم الغامدي** · ديسمبر 18, 2020

3 دقائق مضت, عفرنس said:

أما أسماء المعلمين فهي مستقلة ولذلك تلاحظ انها في جدول مستقل ..

ورقة بيانات الطلاب التي تستوردها من أكسل يوجد بها معلومات كثيرة ومن ضمنها اسم معلم المادة! وبالتالي يمكن تضمين اسم المعلم ضمن جدول بيانات الطلاب، كما هو الحال مع اسم الشعبة والمادة...

لكن ليس لديّ منها شيء حتى أطبق عليها

**عفرنس** · ديسمبر 18, 2020

9 دقائق مضت, أبو إبراهيم الغامدي said:

بعدها هذا التوضيح، لدي اقتراح فيما يتعلق بتصفية البيانات..

في اعتقادي أننا لسنا بحاجة إلى إنشاء جدول مؤقت لترحيل البيانات إلى أكسل! بل يمكن استخدام جدول الطلاب مباشرة!

المنهج CopyFromRecordset له محددان إضافيان هما عدد الأعمدة، وعدد الصفوف المطلوب جلب البيانات منها في مصدر السجل.. إذا أردنا مزيدا من التحكم..

افعل ما تراه مناسبا .. المهم نصل الى النتيجة ..

يسر الله امرك ..

8 دقائق مضت, ابو البشر said:

كلامك كله صيحيح لأنه يعمل على موقع نور ....

فيموقع نور يتم تصدير جداول المعلمين وجداول الطلاب ومنها يمكن الربط بين جداول الطلاب والمعلمين بطريقه تسهل عليك كا ما تريد فهله فيما بعد .... لكن طالما انك بدأت بطرقك هذه إذا لابد من البحث من مخرج ..... وقد تجد لها حل من الاخوة الخبراء ...

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

وأشكر لك مشاركتك واهتمامك ..

4 دقائق مضت, أبو إبراهيم الغامدي said:

ورقة بيانات الطلاب التي تستوردها من أكسل يوجد بها معلومات كثيرة ومن ضمنها اسم معلم المادة! وبالتالي يمكن تضمين اسم المعلم ضمن جدول بيانات الطلاب، كما هو الحال مع اسم الشعبة والمادة...

لكن ليس لديّ منها شيء حتى أطبق عليها

الان ارفق لك البرنامج وفيه بعض البيانات ..

**عفرنس** · ديسمبر 18, 2020

15 دقائق مضت, عفرنس said:

افعل ما تراه مناسبا .. المهم نصل الى النتيجة ..

يسر الله امرك ..

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

وأشكر لك مشاركتك واهتمامك ..

الان ارفق لك البرنامج وفيه بعض البيانات ..

@أبو إبراهيم الغامدي

تجربة.rar

تم تعديل ديسمبر 18, 2020 بواسطه عفرنس

أبو عبدالله الحلوانى · ديسمبر 18, 2020

12 دقائق مضت, أبو إبراهيم الغامدي said:

المنهج CopyFromRecordset له محددان إضافيان هما عدد الأعمدة، وعدد الصفوف المطلوب جلب البيانات منها في مصدر السجل.. إذا أردنا مزيدا من التحكم..

حقيقة لم استطع التعامل مع CopyFromRecordset ظهرت أخطاء لم استطع معالجتها ولعل صاحب الموضوع قد ذكر شىء من تلك الأخطاء ببداية الموضوع. لذا قمت بجلب البيانات باستخدام For

من اجل ذلك سأنتظر رد أستاذنا @أبو إبراهيم الغامدي للتعلم والاستفادة

أما عن طريقتي في حل الطلب الأستاذ @عفرنس وفقا للتوضيح الأخير. فكنت أنوي وضع هذا في بداية الكود

If ShabaNo <= 4 Then
    shetNo = Val(ShabaNo * 2)
Else
    Select Case ShabaNo
    Case 5
        shetNo = 2
    Case 6
        shetNo = 4
    Case 7
        shetNo = 6
    Case 8
        shetNo = 8
    End Select
End If

وأكرر سأنتظر رد أستاذنا @أبو إبراهيم الغامدي للتعلم والاستفادة

**أبو إبراهيم الغامدي** · ديسمبر 19, 2020

17 ساعات مضت, عفرنس said:

افعل ما تراه مناسبا .. المهم نصل الى النتيجة ..

أهلا بالجميع..

الفكرة التي تناولتها حسب البيانات المتوفرة كاللآتي

بما أن المقرر الدراسي يمكن أن يكون في أكثر من شعبة، والطلاب يتبعون للشعب فسوف يكون ترشيح البيانات كما يلي

_ المقرر

- شعبة1 - طلاب

- شعبة 2- طلاب

وهكذا حسب الشعب المدرجة لكل مقرر

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

Public Sub barnaExcelFile(sXlsFile As String)
  Dim fldrname As String
  Dim fldrpath As String
  Dim LExcelOriginal      As String
  Dim LExcelCopyOf        As String
  Dim WHERE$ '.. اللاحقة $ تعني أن المتغير نصي
  
  Dim RS_SECTIONS As DAO.Recordset
  Dim RS_STUDENTS As DAO.Recordset
  Dim fso As Object
  Dim objExcel     As Object
  Dim objWorkbook  As Object
  
  '-- إنشاء مجلد للمقرر
  Set fso = CreateObject("scripting.filesystemobject")
  fldrname = Me.[text3]
  fldrpath = CurrentProject.Path & "\السجل الالكتروني\" & fldrname
  If Not fso.FolderExists(fldrpath) Then
    fso.createfolder (fldrpath)
  End If
    
  '-- التأكد من توفر البيانات الأولية
  If Len(Me.text2) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')AND (Student.الشعبة='" & Me.text2 & "')"
  ElseIf Len(Me.text3) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')"
  Else
    MsgBox "بينات التصدير غير مكتملة"
    Exit Sub
  End If
  
  '-- إيجاد الشعب
  Set RS_SECTIONS = CurrentDb.OpenRecordset _
  ("SELECT  DISTINCT [الشعبة] FROM Student " & WHERE$ & "ORDER BY [الشعبة]")
  
  If RS_SECTIONS.RecordCount = 0 Then
    MsgBox "لا توجد بيانات لتصديرها"
    Exit Sub
  End If
  '-- نسخ قالب مصنف البيانات إلى مجلد المقرر
  LExcelOriginal = sXlsFile
  LExcelCopyOf = CurrentProject.Path & "\السجل الالكتروني\" & fldrname & "\" & Me.[text3] & "_.xlsm"
  Call FileCopy(LExcelOriginal, LExcelCopyOf)
  
  Set objExcel = CreateObject("Excel.Application")
  Set objWorkbook = objExcel.Workbooks.Open(LExcelCopyOf)

  '-- تدوير البيانات بناء على الشعب
  Dim SHEET%
  SHEET% = 2
  Do Until RS_SECTIONS.EOF
    '-- إيجاد أسماء الطلاب بناء على الشعبة
    Set RS_STUDENTS = CurrentDb.OpenRecordset _
    ("SELECT STUACDID,STUNAME FROM STUDENT WHERE [الشعبة]='" & RS_SECTIONS![الشعبة] & "' ORDER BY STUNAME")
    
    '-- بيانات الترويسة
    objWorkbook.Sheets(SHEET%).range("B1").Value = _
    "اسماء طلاب الصف " & "(" & Me.[text1] & ")" _
    & " -- " & "(" & RS_SECTIONS![الشعبة] & ")" _
    & " المادة " & "(" & Me.[text3] & ")" _
    & " معلم المادة / " & "(" & Me.[text4] & ")"

    '-- بيانات الطلاب
    objWorkbook.Sheets(SHEET%).range("c5").CopyFromRecordset RS_STUDENTS
    SHEET% = SHEET% + 2
    '-- الانتقال إلى الشعبة التالية
    RS_SECTIONS.MoveNext
  Loop
  '-- حفظ البيانات
  objExcel.DisplayAlerts = True
  objWorkbook.Close SaveChanges:=True
  
  '-- إغلاق المصادر
  objExcel.Quit
  Set objWorkbook = Nothing
  Set objExcel = Nothing
  Set RS_SECTIONS = Nothing
  Set RS_STUDENTS = Nothing

'  VBA.Shell "Explorer.exe " & Chr(34) & LExcelCopyOf & Chr(34), vbNormalFocus"هذا السطر لفتح ملف الاكسل بعد التصدير"
'  DoCmd.DeleteObject acTable, "temp"
  MsgBox "تم تصديرالبيانات بنجاح"
End Sub

إليكم المرفق

Active Teacher.zip

**عفرنس** · ديسمبر 19, 2020

إخواني الفضلاء .. @أبو عبدالله الحلوانى @أبو إبراهيم الغامدي

تحية طيبة لكم ..

بعد تجربة الكود الذي تفضل به أخي @أبو عبدالله الحلوانى فقد وجدته هو المطلوب ويفي بالمقصود مع بعض التعديل في حال الحاجة . وفقكم الله جميعا .. ولا حرمكم الأجر .

If ShabaNo <= 4 Then
    shetNo = Val(ShabaNo * 2)
Else
    Select Case ShabaNo
    Case 5
        shetNo = 2
    Case 6
        shetNo = 4
    Case 7
        shetNo = 6
    Case 8
        shetNo = 8
    End Select
End If

**Barna** · ديسمبر 20, 2020

22 ساعات مضت, أبو إبراهيم الغامدي said:

أهلا بالجميع..

الفكرة التي تناولتها حسب البيانات المتوفرة كاللآتي

بما أن المقرر الدراسي يمكن أن يكون في أكثر من شعبة، والطلاب يتبعون للشعب فسوف يكون ترشيح البيانات كما يلي

_ المقرر

- شعبة1 - طلاب

- شعبة 2- طلاب

وهكذا حسب الشعب المدرجة لكل مقرر

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


Public Sub barnaExcelFile(sXlsFile As String)
  Dim fldrname As String
  Dim fldrpath As String
  Dim LExcelOriginal      As String
  Dim LExcelCopyOf        As String
  Dim WHERE$ '.. اللاحقة $ تعني أن المتغير نصي
  
  Dim RS_SECTIONS As DAO.Recordset
  Dim RS_STUDENTS As DAO.Recordset
  Dim fso As Object
  Dim objExcel     As Object
  Dim objWorkbook  As Object
  
  '-- إنشاء مجلد للمقرر
  Set fso = CreateObject("scripting.filesystemobject")
  fldrname = Me.[text3]
  fldrpath = CurrentProject.Path & "\السجل الالكتروني\" & fldrname
  If Not fso.FolderExists(fldrpath) Then
    fso.createfolder (fldrpath)
  End If
    
  '-- التأكد من توفر البيانات الأولية
  If Len(Me.text2) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')AND (Student.الشعبة='" & Me.text2 & "')"
  ElseIf Len(Me.text3) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')"
  Else
    MsgBox "بينات التصدير غير مكتملة"
    Exit Sub
  End If
  
  '-- إيجاد الشعب
  Set RS_SECTIONS = CurrentDb.OpenRecordset _
  ("SELECT  DISTINCT [الشعبة] FROM Student " & WHERE$ & "ORDER BY [الشعبة]")
  
  If RS_SECTIONS.RecordCount = 0 Then
    MsgBox "لا توجد بيانات لتصديرها"
    Exit Sub
  End If
  '-- نسخ قالب مصنف البيانات إلى مجلد المقرر
  LExcelOriginal = sXlsFile
  LExcelCopyOf = CurrentProject.Path & "\السجل الالكتروني\" & fldrname & "\" & Me.[text3] & "_.xlsm"
  Call FileCopy(LExcelOriginal, LExcelCopyOf)
  
  Set objExcel = CreateObject("Excel.Application")
  Set objWorkbook = objExcel.Workbooks.Open(LExcelCopyOf)

  '-- تدوير البيانات بناء على الشعب
  Dim SHEET%
  SHEET% = 2
  Do Until RS_SECTIONS.EOF
    '-- إيجاد أسماء الطلاب بناء على الشعبة
    Set RS_STUDENTS = CurrentDb.OpenRecordset _
    ("SELECT STUACDID,STUNAME FROM STUDENT WHERE [الشعبة]='" & RS_SECTIONS![الشعبة] & "' ORDER BY STUNAME")
    
    '-- بيانات الترويسة
    objWorkbook.Sheets(SHEET%).range("B1").Value = _
    "اسماء طلاب الصف " & "(" & Me.[text1] & ")" _
    & " -- " & "(" & RS_SECTIONS![الشعبة] & ")" _
    & " المادة " & "(" & Me.[text3] & ")" _
    & " معلم المادة / " & "(" & Me.[text4] & ")"

    '-- بيانات الطلاب
    objWorkbook.Sheets(SHEET%).range("c5").CopyFromRecordset RS_STUDENTS
    SHEET% = SHEET% + 2
    '-- الانتقال إلى الشعبة التالية
    RS_SECTIONS.MoveNext
  Loop
  '-- حفظ البيانات
  objExcel.DisplayAlerts = True
  objWorkbook.Close SaveChanges:=True
  
  '-- إغلاق المصادر
  objExcel.Quit
  Set objWorkbook = Nothing
  Set objExcel = Nothing
  Set RS_SECTIONS = Nothing
  Set RS_STUDENTS = Nothing

'  VBA.Shell "Explorer.exe " & Chr(34) & LExcelCopyOf & Chr(34), vbNormalFocus"هذا السطر لفتح ملف الاكسل بعد التصدير"
'  DoCmd.DeleteObject acTable, "temp"
  MsgBox "تم تصديرالبيانات بنجاح"
End Sub

إليكم المرفق

Active Teacher.zip 1.6 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 8 downloads

اخي @أبو إبراهيم الغامدي

هل يمكن تعديل الشيفرة السابقة ليكون اسم الشيت هو اسم الشعبة المصدرة لتلك الورقة ......

بارك الله فيك ..

**عفرنس** · ديسمبر 20, 2020

7 دقائق مضت, Barna said:

اخي @أبو إبراهيم الغامدي

هل يمكن تعديل الشيفرة السابقة ليكون اسم الشيت هو اسم الشعبة المصدرة لتلك الورقة ......

بارك الله فيك ..

👍👍

ننتظر رد الأخ الفاضل @أبو إبراهيم الغامدي

**أبو إبراهيم الغامدي** · ديسمبر 20, 2020

@Barna @عفرنس

أهلا بكما..

نعم.. يمكن ذلك! لكني بحاجة إلى مزيد من التوضيح! لأن التبويبات مسماة مسبقا يأسماء الشعب! ما الذي يحيركما؟! أريد أن أعرف أكثر..

قد كانت عندي اشكالية فيما إذا اختار المستخدم شعبا محددة بعينها لا تتوافق مع هو مقدر في قالب أكسل إما بزيادة أو نقص،أو كانت الشعب المقررة للمعلم ليست متسلسلة..

**Barna** · ديسمبر 20, 2020

46 دقائق مضت, أبو إبراهيم الغامدي said:

@Barna @عفرنس

أهلا بكما..

نعم.. يمكن ذلك! لكني بحاجة إلى مزيد من التوضيح! لأن التبويبات مسماة مسبقا يأسماء الشعب! ما الذي يحيركما؟! أريد أن أعرف أكثر..

قد كانت عندي اشكالية فيما إذا اختار المستخدم شعبا محدة بعينها لا تتوافق مع هو مقدر في قلب أكسل إما بزيادة أو نقص،أو كانت الشعب المقررة للمعلم ليست متسلسلة..

اهلا بك استاذي الفاضل ....

الهدف من التعديل المطلوب وهو : ان للمادة الواحدة اكثر معلم للشعب المختلفة وملف الاكسل ملف عام فمثلا مادة الاحياء1 لدينا ثلاث معلمين مثلا فليس من المنطق أن اجعل الملف الالكتروني المصدرله ثلاث ملفات ( بل يكون ملف عام لكل تخصص ) وعند اختيار الملف من البرنامج أحياء مثلا يقوم البرنامج كما فعلت انت نسخة ثم ملئ البيانات حسب المعلم بحيث يصدر اسماء الشعب الى كل شيت ويقوم البرنامج بتغيير اسم الشيت حسب الشعبة ... ارجو ان اكون وضحت الصورة ....

وبارك الله في أخي الكريم ...

تم تعديل ديسمبر 20, 2020 بواسطه Barna

**Barna** · ديسمبر 20, 2020

تم التوصل الى المطلوب وهذا هو التعديل ....

  Dim fldrname As String
  Dim fldrpath As String
  Dim LExcelOriginal      As String
  Dim LExcelCopyOf        As String
  Dim WHERE$ '.. اللاحقة $ تعني أن المتغير نصي
  
  Dim RS_SECTIONS As DAO.Recordset
  Dim RS_STUDENTS As DAO.Recordset
  Dim fso As Object
  Dim objExcel     As Object
  Dim objWorkbook  As Object
  
  '-- إنشاء مجلد للمقرر
  Set fso = CreateObject("scripting.filesystemobject")
  fldrname = Me.[text3]
  fldrpath = CurrentProject.Path & "\السجل الالكتروني\" & fldrname
  If Not fso.FolderExists(fldrpath) Then
    fso.createfolder (fldrpath)
  End If
    
  '-- التأكد من توفر البيانات الأولية
  If Len(Me.text2) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')AND (Student.الشعبة='" & Me.text2 & "')"
  ElseIf Len(Me.text3) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')"
  Else
    MsgBox "بينات التصدير غير مكتملة"
    Exit Sub
  End If
  
  '-- إيجاد الشعب
  Set RS_SECTIONS = CurrentDb.OpenRecordset _
  ("SELECT  DISTINCT [الشعبة] FROM Student " & WHERE$ & "ORDER BY [الشعبة]")
  
  If RS_SECTIONS.RecordCount = 0 Then
    MsgBox "لا توجد بيانات لتصديرها"
    Exit Sub
  End If
  '-- نسخ قالب مصنف البيانات إلى مجلد المقرر
  LExcelOriginal = sXlsFile
  LExcelCopyOf = CurrentProject.Path & "\السجل الالكتروني\" & fldrname & "\" & Me.[text3] & "_.xlsm"
  Call FileCopy(LExcelOriginal, LExcelCopyOf)
  
  Set objExcel = CreateObject("Excel.Application")
  Set objWorkbook = objExcel.Workbooks.Open(LExcelCopyOf)

  '-- تدوير البيانات بناء على الشعب
  Dim SHEET%
  SHEET% = 2
  Do Until RS_SECTIONS.EOF
  
  
  
    '-- إيجاد أسماء الطلاب بناء على الشعبة
    Set RS_STUDENTS = CurrentDb.OpenRecordset _
    ("SELECT STUACDID,STUNAME FROM STUDENT WHERE [الشعبة]='" & RS_SECTIONS![الشعبة] & "' ORDER BY STUNAME")
    ' تعديل اسم صفحات الاكسل حسب اسماء الاستعلامات
    objWorkbook.Sheets(SHEET%).Name = RS_SECTIONS![الشعبة]

    
    
    '-- بيانات الترويسة
    objWorkbook.Sheets(SHEET%).range("B1").Value = _
    "اسماء طلاب الصف " & "(" & Me.[text1] & ")" _
    & " -- " & "(" & RS_SECTIONS![الشعبة] & ")" _
    & " المادة " & "(" & Me.[text3] & ")" _
    & " معلم المادة / " & "(" & Me.[text4] & ")"

    '-- بيانات الطلاب
    objWorkbook.Sheets(SHEET%).range("c5").CopyFromRecordset RS_STUDENTS
    SHEET% = SHEET% + 2


    '-- الانتقال إلى الشعبة التالية
    RS_SECTIONS.MoveNext
  Loop
  '-- حفظ البيانات
  objExcel.DisplayAlerts = True
  objWorkbook.Close SaveChanges:=True
  
  '-- إغلاق المصادر
  objExcel.Quit
  Set objWorkbook = Nothing
  Set objExcel = Nothing
  Set RS_SECTIONS = Nothing
  Set RS_STUDENTS = Nothing

'  VBA.Shell "Explorer.exe " & Chr(34) & LExcelCopyOf & Chr(34), vbNormalFocus"هذا السطر لفتح ملف الاكسل بعد التصدير"
'  DoCmd.DeleteObject acTable, "temp"
  MsgBox "تم تصديرالبيانات بنجاح"

تم اضافة هذه الشيفرية ....

    ' تعديل اسم صفحات الاكسل حسب اسماء الاستعلامات
    objWorkbook.Sheets(SHEET%).Name = RS_SECTIONS![الشعبة]

**عفرنس** · ديسمبر 20, 2020

13 دقائق مضت, Barna said:

تم التوصل الى المطلوب وهذا هو التعديل ....



  Dim fldrname As String
  Dim fldrpath As String
  Dim LExcelOriginal      As String
  Dim LExcelCopyOf        As String
  Dim WHERE$ '.. اللاحقة $ تعني أن المتغير نصي
  
  Dim RS_SECTIONS As DAO.Recordset
  Dim RS_STUDENTS As DAO.Recordset
  Dim fso As Object
  Dim objExcel     As Object
  Dim objWorkbook  As Object
  
  '-- إنشاء مجلد للمقرر
  Set fso = CreateObject("scripting.filesystemobject")
  fldrname = Me.[text3]
  fldrpath = CurrentProject.Path & "\السجل الالكتروني\" & fldrname
  If Not fso.FolderExists(fldrpath) Then
    fso.createfolder (fldrpath)
  End If
    
  '-- التأكد من توفر البيانات الأولية
  If Len(Me.text2) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')AND (Student.الشعبة='" & Me.text2 & "')"
  ElseIf Len(Me.text3) Then
    WHERE$ = " WHERE (Student.المادة='" & Me.text3 & "')"
  Else
    MsgBox "بينات التصدير غير مكتملة"
    Exit Sub
  End If
  
  '-- إيجاد الشعب
  Set RS_SECTIONS = CurrentDb.OpenRecordset _
  ("SELECT  DISTINCT [الشعبة] FROM Student " & WHERE$ & "ORDER BY [الشعبة]")
  
  If RS_SECTIONS.RecordCount = 0 Then
    MsgBox "لا توجد بيانات لتصديرها"
    Exit Sub
  End If
  '-- نسخ قالب مصنف البيانات إلى مجلد المقرر
  LExcelOriginal = sXlsFile
  LExcelCopyOf = CurrentProject.Path & "\السجل الالكتروني\" & fldrname & "\" & Me.[text3] & "_.xlsm"
  Call FileCopy(LExcelOriginal, LExcelCopyOf)
  
  Set objExcel = CreateObject("Excel.Application")
  Set objWorkbook = objExcel.Workbooks.Open(LExcelCopyOf)

  '-- تدوير البيانات بناء على الشعب
  Dim SHEET%
  SHEET% = 2
  Do Until RS_SECTIONS.EOF
  
  
  
    '-- إيجاد أسماء الطلاب بناء على الشعبة
    Set RS_STUDENTS = CurrentDb.OpenRecordset _
    ("SELECT STUACDID,STUNAME FROM STUDENT WHERE [الشعبة]='" & RS_SECTIONS![الشعبة] & "' ORDER BY STUNAME")
    ' تعديل اسم صفحات الاكسل حسب اسماء الاستعلامات
    objWorkbook.Sheets(SHEET%).Name = RS_SECTIONS![الشعبة]

    
    
    '-- بيانات الترويسة
    objWorkbook.Sheets(SHEET%).range("B1").Value = _
    "اسماء طلاب الصف " & "(" & Me.[text1] & ")" _
    & " -- " & "(" & RS_SECTIONS![الشعبة] & ")" _
    & " المادة " & "(" & Me.[text3] & ")" _
    & " معلم المادة / " & "(" & Me.[text4] & ")"

    '-- بيانات الطلاب
    objWorkbook.Sheets(SHEET%).range("c5").CopyFromRecordset RS_STUDENTS
    SHEET% = SHEET% + 2


    '-- الانتقال إلى الشعبة التالية
    RS_SECTIONS.MoveNext
  Loop
  '-- حفظ البيانات
  objExcel.DisplayAlerts = True
  objWorkbook.Close SaveChanges:=True
  
  '-- إغلاق المصادر
  objExcel.Quit
  Set objWorkbook = Nothing
  Set objExcel = Nothing
  Set RS_SECTIONS = Nothing
  Set RS_STUDENTS = Nothing

'  VBA.Shell "Explorer.exe " & Chr(34) & LExcelCopyOf & Chr(34), vbNormalFocus"هذا السطر لفتح ملف الاكسل بعد التصدير"
'  DoCmd.DeleteObject acTable, "temp"
  MsgBox "تم تصديرالبيانات بنجاح"

تم اضافة هذه الشيفرية ....



    ' تعديل اسم صفحات الاكسل حسب اسماء الاستعلامات
    objWorkbook.Sheets(SHEET%).Name = RS_SECTIONS![الشعبة]

لعلك أخي @Barna ترفق البرنامج بعد التعديل الذي تفضلت به ..

تم تعديل ديسمبر 20, 2020 بواسطه عفرنس

**عفرنس** · ديسمبر 20, 2020

@Barna تم إضافة التعديل الذي تفضلة به وعند التجربة تظهر الرسالة المرفقة في الصورة

**عفرنس** · ديسمبر 20, 2020

9 دقائق مضت, عفرنس said:

@Barna تم إضافة التعديل الذي تفضلة به وعند التجربة تظهر الرسالة المرفقة في الصورة

تم حل المشكلة بحذف exit sub لكن هناك مشكلة أخرى وهي : انه تم اضافة جميع طلاب المستوى في الشيت كما ترى في الصورة المرفقة ..

نحتاج تصفية الطلاب بحيث ما يعطي الا طلاب الشعبة فقط

تم تعديل ديسمبر 20, 2020 بواسطه عفرنس

تسجيل الدخول

اضافة البيانات في أكثر من شيت في ملف اكسل

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

رابط هذا التعليق

شارك

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

أبو إبراهيم الغامدي

أبو عبدالله الحلوانى

أبو إبراهيم الغامدي

Posted Images

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

Join the conversation

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

Important Information