Barna

على كل حال استبدل الكود الموجود في الزر بهذا ..................................... Call GetWaiting("Please wait ... data is processing") On Error Resume Next Dim db As DAO.Database Dim rstFrom As Recordset Dim rstTo As Recordset Set db = CurrentDb() Dim RC, i, r, rr As Integer Set rstTo = db.OpenRecordset(Me.Combo15, dbOpenDynaset) Set rstFrom = db.OpenRecordset("tblTemp", dbOpenDynaset) CurrentDb.Execute ("Delete * From tblTemp") rstFrom.MoveFirst: rstFrom.MoveLast RC = rstFrom.RecordCount rstFrom.MoveFirst For i = 1 To RC rstTo.AddNew For r = 0 To rstFrom.Fields.Count - 1 For rr = 0 To rstTo.Fields.Count - 1 If rstFrom.Fields(r).name = rstTo.Fields(rr).Properties("Caption") Or rstFrom.Fields(r).name = rstTo.Fields(rr).name Then rstTo.Fields(rr) = rstFrom.Fields(r) End If Next rr Next r rstTo.Update rstFrom.MoveNext r = 0 rr = 0 Next i DoCmd.Close acForm, "frmWaiting" rstTo.Close rstFrom.Close Set rstTo = Nothing Set rstFrom = Nothing Set db = Nothing طبعا هذا الكود بيتعرف على اسم الحقل واذا وجد اسم الحقل مختلف ينتقل الى التسمية التوضيحة للحق لتنفيذ امر نقل البيانات للجدول ................

طيب ايش النسخة التي تعمل عليها ..... هل هي اخر نسخة انا ارفقتها ؟؟؟؟؟ حتى نعدل عليها .....

في جدولك مفتاح لا يتكرر ... فلذلك تظهر معك الرسالة بعدم التكرار

لاحظ اخي المشكلة اين ؟؟؟؟ انظر الصورة الاسماء مختلف وليس سوى حقل واحد متشابه

ارفق نموذج لملف الاكسل مع جدول الاكسس المصدر له البيانات

خل لاحظت العبارة التي باللون الاحمر

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

في حدث عند فتح النموذج ضع هذا الكود ........................ مع تعديل بيانات الكود حسب جدولك وحقل CHEK Dim x As Integer x = DCount("[ck]", "[student_wezara]", "[ck] =0") MsgBox " عدد السجلات الخطأ هي " & x & " سجل ", vbInformation, "سجلات"

طيب جرب كده ...................... StudentsName.rar

طيب جرب المرفق واعلمنا ......( يجب ان تتطابق اسماء الحقول المستوردة مع الجدول المصدر له .......) Import Frome Excel File.rar

اذن مشكلتك في ترتيب الحقول .... لأننا اعتمدنا عليها .... طيب بعد الاستيراد من الاكسل افتح الجدول tbltemp وقارن الحقول ( ترتيبا ونوع بيانات ) هل هي نفسها في الصورة ؟؟

وهل في الحالتين فشلت العملية ... أم ماذا ؟؟؟

هل عدد الحقول المستورده ( اقصد tbltemp ) هي نفس عدد الحقول في الجدول المصدر له البيانات .................... لذلك انا سألتك ابتداءا عن الحقول ؟؟؟؟ هل الجدول المصدر له البيانات موجود في المرفق السابق

طيب شوف كده >>>>>>>>>>>>>>>>>>>> جرب واخبرنا ................... Import Frome Excel File.rar

اذن جاري التعديل على مرفقك .... انظرني <<<<<<<<<

سؤالي كان محدد ..... لان اسماء الحقول لو كانت مختلفة .... فكيف تخبر البرنامج ان الاسم في هذا الجدول هو اسم الطالب في الجدول الاخر .... علما كان طلبك ان التصدير يكون لجداول يتم اختيارها من خلال الكمبوبكس اي ليس جدولا محددا ... فلو كان جدولا محددا كانت العملية سهلة عن طريق الالحاق وكفي ..... انظر الصورة لجدولين واختلاف الاسماء بها ....... ليس لدينا سوى حل واحد وهر الاعتمان على ترتيب الحقل في الجدولين ((( فهل ترتيب الحقول في الجداول المراد تصدير البيانات لها هي نفس ترتيب الحقول في جدول tbltemp

يتبادر في الذهن سؤال :::: هل اسماء الحقول في الجدولين متشابهين تماما ( اقصد الجدول المنقول منه والجدول المنقول له ) أم تريد نقل البيانات كيفما كانت ........

ادرج مثال مبسط للتعديل عليه

ممكن مثال للجدول ... وماهي البيانات التي تريد ظهورها فقط

اعمل جدول وادرج السنوات المطلوبة بالكود ....

هل هذه الصورة المطلوبة ..... استخدم هذا ..... H: Year(Now()) & "-" & Year(Now())+1 & "-" & Year(Now())+2

طيب ... جرب الملف ..... Bar11.mdb

وعليكم السلام ... كان المفروض منك ادراج ملف مثال ليتم التعديل .... على العموم تفضل هذا المثال ... طبقه على ملفك ..... Bar11.mdb

اخي الكريم اقرأ ردي السابق

وعليكم السلام ورحمة الله وبركاته .... طيب في اعلا الصفحة ضع هذا ..... Option Compare Database #If VBA7 Then Private Declare PtrSafe Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long #Else Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long #End If ثم في حدث عند التركيز على مربع النص العربي ضع هذا ..... On Error Resume Next Dim kbd As Long kbd = GetKeyboardLayout(0) kbd = Hex(kbd) If Right(kbd, 1) <> 1 Then SendKeys "%+" End If