كل الانشطه

Private Sub Worksheet_Change(ByVal Target As Range) 'لادراج بيانات الاسم في حال تكراره If Target.Column = 2 And Target.Row > 1 Then Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlManual Dim rw& On Error Resume Next rw = Range("q:q").Find(Target.Value, Target, , 1, , 2).Row Target.Offset(, 1).Value = Cells(rw, 3).Value Target.Offset(, 2).Value = Cells(rw, 4).Value Target.Offset(, 3).Value = Cells(rw, 5).Value Target.Offset(, 4).Value = Cells(rw, 6).Value Target.Offset(, 5).Value = Cells(rw, 7).Value Target.Offset(, 6).Value = Cells(rw, 8).Value Target.Offset(, 7).Value = Cells(rw, 9).Value Target.Offset(, 8).Value = Cells(rw, 10).Value Target.Offset(, 9).Value = Cells(rw, 11).Value Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'لادراج بيانات الاسم في حال تكراره If Target.Column = 2 And Target.Row > 1 Then Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlManual Dim rw& On Error Resume Next rw = Range("q:q").Find(Target.Value, Target, , 1, , 2).Row Target.Offset(, 1).Value = Cells(rw, 3).Value Target.Offset(, 2).Value = Cells(rw, 4).Value Target.Offset(, 3).Value = Cells(rw, 5).Value Target.Offset(, 4).Value = Cells(rw, 6).Value Target.Offset(, 5).Value = Cells(rw, 7).Value Target.Offset(, 6).Value = Cells(rw, 8).Value Target.Offset(, 7).Value = Cells(rw, 9).Value Target.Offset(, 8).Value = Cells(rw, 10).Value Target.Offset(, 9).Value = Cells(rw, 11).Value Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdati ng = True End If End Sub السلام عليكم فضلا وليس امرا تعديل على كود في حد الصفحة لجلب بيانات الموظف في حال تكرار الاسم مع جزيل الشكر بيانات الموظف.xlsm.xlsx

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

تفضل استاذ @RAIANESAMI طلبك حسب ما فهمت بالمرفق . ووافني بالرد . DDFinding Differences.rar

السلام عليكم ورحمة الله وبركاته شكرا جزيلا وتستحق الشكر والثناء عمل معي بالرسائل جيدا ولكن المرفقات لا ترسل ( يرسل صورة ولكن فارغه بيضاء ) مع التحية والتقدير

استاذي الغملاق Foksh كعادتك بسرعة الاجابة الوافية تجعل حرفي يعجز ان يوفي من شكر بارك الله فيك وادم علمك تقديري

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

السلام عليكم لدي جدولين T1و T2 لاسماء الموظفين واريد استغلام يبحث عن إختلافات الجدولبن المموظفين من ناحية رقم الموظف الاسم واللقب وتاريخ الميلاد وعندما يجد اسم جديد في جدول T1 يضيفه الى الجدول db4.mdbT2

أداة رائعة جدا .. شكرا لك

تمام هو المطلوب شكرا جزيلا

وعليكم السلام ورحمة الله وبركاته ،، جرب هذا التعديل على حسب ما فهمت من الشرح Sub Test_Optimized() Dim ws As Worksheet, dataArr As Variant, outputArr() As Variant Dim i As Long, ii As Long, p As Long, startRow As Long, endRow As Long Dim chunkSize As Long, chunkStart As Long, chunkEnd As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set ws = ActiveSheet chunkSize = 5000 ReDim outputArr(1 To chunkSize * 10, 1 To 14) With ws .Columns("Q:P").Clear .Columns("P").ColumnWidth = 12 .Range("R1").Resize(, 14).Value = Array("الدفعة", "ج", "ت ح", "ت م", "ت ع", "ل ع", "ل ح", "ل م", "ل ع1", "ر ع1", "ل ح1", "ر ح1", "ل م", "ر م1") .Range("R1").Resize(, 14).Interior.Color = RGB(146, 205, 220) .Range("R1").Resize(, 14).HorizontalAlignment = xlCenter For chunkStart = 2 To 13000 Step chunkSize chunkEnd = chunkStart + chunkSize - 1 If chunkEnd > 13000 Then chunkEnd = 13000 dataArr = .Range("A" & chunkStart & ":N" & chunkEnd).Value p = 1 For i = LBound(dataArr, 1) To UBound(dataArr, 1) If IsNumeric(dataArr(i, 2)) And IsNumeric(dataArr(i, 3)) Then startRow = dataArr(i, 2) endRow = dataArr(i, 3) For ii = startRow To endRow outputArr(p, 1) = dataArr(i, 1) outputArr(p, 2) = ii outputArr(p, 3) = dataArr(i, 4) outputArr(p, 4) = dataArr(i, 5) outputArr(p, 5) = dataArr(i, 6) outputArr(p, 6) = dataArr(i, 7) outputArr(p, 7) = dataArr(i, 8) outputArr(p, 8) = dataArr(i, 9) outputArr(p, 9) = dataArr(i, 10) outputArr(p, 10) = dataArr(i, 11) outputArr(p, 11) = dataArr(i, 12) outputArr(p, 12) = dataArr(i, 13) outputArr(p, 13) = dataArr(i, 14) outputArr(p, 14) = dataArr(i, 14) p = p + 1 Next ii End If Next i If p > 1 Then .Range("R" & chunkStart).Resize(p - 1, 14).Value = outputArr ReDim outputArr(1 To chunkSize * 10, 1 To 14) End If Next chunkStart End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub

هل هذا ما تريده ؟ class_be1.accdb

السلام عليكم عاشت ايدك استاذ شكرأ جزيلاً

المقصود عمل نموذج لتجميع البيانات بجدول واحد

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

على اي أساس سيتم تمييز السجلات الخاصة بالجهاز ولنفترض Pc1 و Pc2 ... إلخ .؟؟؟ لنفترض انني Pc1 على شبكة Net1 وموظف آخر على شبكة Net2 باسم Pc1 أيضاً !!!!! هل فهمت المقصود ؟؟ ما الرابط فيما بينهم !!!!!

شكرا لاهتمامك اخي الفاضل عندي قاعدة بيانات موجوده على أكثر من جهاز اماكن متفرقه مش على شبكه واحده مثلا الجهاز الاول بيسجل أسماء من كود 1 - 1000وهكذا الجهاز الثاني من 1001 الى 2000 والثالث من 3001 الى 4000 وهكذا المطلوب عمل نسخة تجميع لكل البيانات التي تمت كتابتها على جميع الاجهزة

وعليكم السلام ورحمة الله وبركاته .. المطلوب غير مفهوم للأسف !! نرجو منك التوضيح أكثر أخي الفاضل

تفضل .. class_be.accdb

السلام عليكم الرجاء المساعده من الاحباب الكرام محتاج اعمل نسخة تجميع لقاعدة بيانات موحده على أكثر من جهاز ما الخطأف في هذا الكود مرفق قاعدة البيانات Option Compare Database Option Explicit Dim addsql, a As String Dim WK As DAO.Workspace Dim db As DAO.Database Dim Chemin As String Private Sub BtImporter_Click() If Nz(cmbTable, "") <> "" Then DupliquerTable db, cmbTable Else MsgBox "اختــر جـــدولا" End If End Sub Private Sub cmd_new_Click() On Error GoTo mm DoCmd.SetWarnings False addsql = "INSERT INTO asdst IN '" & New_DB & "' SELECT [asdst].* FROM asdst;" db.Execute addsql MsgBox ("تم الاستيراد بنجاح"), vbOKOnly + vbMsgBoxRight, " رساله " DoCmd.Close End mm: MsgBox ("تأكد من أختيار ملف الأستيراد الصحيح"), vbOKOnly + vbMsgBoxRight, " رساله " New folder (24).rar

السلام عليكم ورحمة الله وبركاته اساتذتي الكرام مرفق كود المفروض ان يقوم بفك الارقام ( من : الى ) عند الضغط الزر Run فيقوم بذلك الا انه اذا كان هناك رقم لشخص واحد اي ان الرقم ( من ) هو الرقم ( الى ) لا يقوم الكود بنقله اي يتجهله كما هو موضح بالمثال هنا. والمطلوب من حضراتكم تعديل الكود جيث ينقل الرقم الواحد كما ينقل المجموعة اعزكم الله معدل.rar

ماشي ممكن تعمل التقرير وتبعتهولي

إلى الآن لم تتضح أو تظهر لي المشكلة ، والحل باعتقادي بسيط ، هو فقط الاعتماد على الحقل [ClassNo] للفرز التصاعدي .

عند إنشاء تقرير في Access لعرض الفصول الدراسية وعدد التلاميذ في كل صف اعتمادًا على جدول التلاميذ، يظهر ترتيب الفصول أبجديًا (مثلاً: الصف الأول، الصف الثالث، الصف الثاني) بدلاً من الترتيب المنطقي (الصف الأول، الثاني، الثالث...) الهدف ترتيب الفصول في التقرير من الصف الأول حتى الأخير بالترتيب الطبيعي، بحيث يظهر في العمود الأول اسم الفصل وفي العمود المقابل عدد التلاميذ.

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