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

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


عفرنس
إذهب إلى أفضل إجابة Solved by أبو عبدالله الحلوانى,

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

أيضا عند اختيار الشعبة رقم 2 يضيف طلابها في شيت رقم 2 والمفترض يضيفهم في شيت رقم 4 ، وكذلك شعبة 3 المفترض يضيفهم في شيت رقم 6 وكذلك شعبة 4 المفترض يضيفهم في شيت رقم 8 

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

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

الكود شغال في الملف .... انظر ...

 

1.png

2.png

ممتاز لكن ليش كرر اسم الطالب ؟؟ 

الان, عفرنس said:

ممتاز لكن ليش كرر اسم الطالب ؟؟ 

يعني جاء باسم الطالب 7 مرات في الشيت رقم 2 بناء على عدد المواد التي يدرسها .. 

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

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

الكود شغال في الملف .... انظر ...

 

1.png

2.png

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

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

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

يعني جاء باسم الطالب 7 مرات في الشيت رقم 2 بناء على عدد المواد التي يدرسها ..

أعتذر عن هذا الخطأ.. أ. @Barna قام بالواجب

  • Thanks 1
رابط هذا التعليق
شارك

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

ابحث عن هذا الكود لديك 

واستبدله بهذا ...


   ("SELECT STUDENT.STUACDID, STUDENT.STUNAME FROM STUDENT WHERE (((STUDENT.المادة)='" & text3 & "') AND ((STUDENT.الشعبة)='" & RS_SECTIONS![الشعبة] & "')) ORDER BY STUDENT.STUNAME;")

 

1.png

أحسنت الان ضبط عدم تكرار الأسماء .. 

لكن ما زال عندي مشكلة عدم وضع الشعب في الشيت المحدد لكل شعبة .. 

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

أعتذر عن هذا الخطأ.. أ. @Barna قام بالواجب

كلاكما فيه الخير والبركة .. ما قصرتم أخي @أبو إبراهيم الغامدي و أخي @Barna 

لكن يبقى لدي مشكلة عدم وضع شعبة 2 في شيت 4 وشعبة 3 في شيت 6 وشعبة 4 في شيت 8 

لا أدري أين الخلل عندي . 

 

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

الان, Barna said:

الحقيقة لا ادري ولكن الكون يعمل طبيعي لدي

 

1.png

هل في اعتقادك نوع اصدار أكسس ؟؟ 

اللي عندي 2016

الان, عفرنس said:

هل في اعتقادك نوع اصدار أكسس ؟؟ 

اللي عندي 2016

ما رأيك ترفق لي النسخة التي عندك ؟؟ 

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

هل في اعتقادك نوع اصدار أكسس ؟؟ 

اللي عندي 2016

ما رأيك ترفق لي النسخة التي عندك ؟؟ 

هذا قالب الرياضيات الذي أعمل عليه .. @Barna

رياضيات .xlsm

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

منذ ساعه, عفرنس said:

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

@kanory 

هلّا مررت بنا 

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

الحقيقة لا ادري ولكن الكود يعمل طبيعي لدي

 

1.png

..

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

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

المشكلة أخي @Barna @أبو إبراهيم الغامدي تكمن هنا .

1.jpg

أرجو أن تتفهم أنه في هذه المرحلة لا يمكن اختيار شعبة أو شعب بعينها! يجب أن تكون الشعب متسلسة.

لا تقم باختيار قيمة في مربع الشعبة!

 

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

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

أرجو أن تتفهم أنه في هذه المرحلة لا يمكن اختيار شعبة أو شعب بعينها! يجب أن تكون الشعب متسلسة.

لا تقم باختيار قيمة في مربع الشعبة!

 

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

إذا كيف أعمل ؟؟ فأنا لم أفهم ما تفضلت به . 

1.jpg

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

لحل هذه الاشكالية وتمكين اختيار شعب بعينها يلزم تبديل الشفرة يالتالي

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%
  
  Do Until RS_SECTIONS.EOF
    SHEET% = Choose(CInt(RS_SECTIONS![الشعبة]), 2, 4, 6, 8, 2, 4, 6, 8)
    '-- إيجاد أسماء الطلاب بناء على الشعبة
    Set RS_STUDENTS = CurrentDb.OpenRecordset _
    ("SELECT STUACDID,STUNAME FROM STUDENT " _
    & "WHERE (Student.المادة='" & Me.text3 & "') AND (Student.الشعبة='" & 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
        
    '-- الانتقال إلى الشعبة التالية
    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

  • Like 1
رابط هذا التعليق
شارك

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

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

إذا كيف أعمل ؟؟ فأنا لم أفهم ما تفضلت به . 

1.jpg

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

وهذا يعني أنك تستخف بي!

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

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

وهذا يعني أنك تستخف بي!

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

والذي رفع السماء بلا عمد ما طرأ هذا الكلام على بالي .. غفر الله لي ولك .. 

* الأمر الثاني فالنسخة التي أعمل عليها فعلا ليست التي عملتها أنت .. وهذا ربما هو الذي أشكل علي .. 

* وإلى هنا سأتوقف .. 

* وأسأل الله أن يغفر لي ولك .. 

  • Haha 1
رابط هذا التعليق
شارك

أهلا @عفرنس 

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

أرجو بعد الانتهاء من الإجراء أعلاه أن تجرب اختيار شعب عشوائية وتصدرها إلى أكسل لترى النتيجة...

لا تنسخ الشفرة .. انسخ النموذج بالكامل..

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

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

هل في اعتقادك نوع اصدار أكسس ؟؟ 

اللي عندي 2016

ما رأيك ترفق لي النسخة التي عندك ؟؟ 

هذا قالب الرياضيات الذي أعمل عليه .. @Barna

رياضيات .xlsm 421.81 kB · 2 downloads

هذا القالب تختلف عن القالب الاساسي الذي تم العمل عليه ..... انظر

اذا كل ماهو عليك هو تعديل هذا السطر لديك لاحظ بارك الله فيك موقع لصق البيانات كان C5

    objWorkbook.Sheets(SHEET%).range("c5").CopyFromRecordset RS_STUDENTS

الاستبدال يكون بهذا الشكل ولاحظ موقع لصق البيانات اصبح حسب ملفك الجديد C8

    objWorkbook.Sheets(SHEET%).range("c8").CopyFromRecordset RS_STUDENTS

فقط هذا كل شيئ .... ملاحظة يجب ان تكون جميع ملفات الاكسل ( احياء - فيزياء - رياضيات وغيرها بنفس تصميم ملف الرياضيات الجديد اقصد بذلك موقع لصق البيانات اي C8 

ارجو اكون وفقت في الشرح !!!

1.png

2.png

  • Like 2
رابط هذا التعليق
شارك

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

المرفق السابق به خطأ.. أعتذر!

Active Teacher.zip 573.24 kB · 1 download

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

الأمور تسير إلى خير .. 🌹🌹

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information