نجوم المشاركات

وعليكم السلام ورحمة الله وبركاته .. 🙂 1- هل تريد نسخ الجدول كجدول كامل لأنه غير موجود في القاعدة المستهدفة ؟ 2- أم أنك تريد نقل البيانات فقط ؟ في الأولى يمكنك نقل (نسخ) الجدول من قاعدة بيانات إلى أخرى عن طريق الكود التالي : Sub CopyTable() Dim sourceDB As DAO.Database Dim destinationDB As DAO.Database Dim sourceTable As DAO.TableDef Dim destinationTable As DAO.TableDef ' افتح قاعدة البيانات المصدر Set sourceDB = OpenDatabase("مسار قاعدة البيانات المصدر.accdb") ' افتح قاعدة البيانات الهدف Set destinationDB = OpenDatabase("مسار قاعدة البيانات الهدف.accdb") ' حدد الجدول المصدر الذي ترغب في نسخه Set sourceTable = sourceDB.TableDefs("اسم الجدول المصدر") ' إنشاء جدول في قاعدة البيانات الهدف بنفس التركيبة Set destinationTable = destinationDB.CreateTableDef("اسم الجدول الهدف") For Each fld In sourceTable.Fields destinationTable.Fields.Append destinationTable.CreateField(fld.Name, fld.Type, fld.Size) Next fld ' إضافة الجدول الجديد إلى قاعدة البيانات الهدف destinationDB.TableDefs.Append destinationTable ' نسخ بيانات الجدول destinationDB.Execute "INSERT INTO [اسم الجدول الهدف] SELECT * FROM [اسم الجدول المصدر]" ' أغلق قواعد البيانات sourceDB.Close destinationDB.Close ' تحرير الذاكرة Set sourceTable = Nothing Set destinationTable = Nothing Set sourceDB = Nothing Set destinationDB = Nothing MsgBox "تم النسخ بنجاح!" End Sub وفي حال أنك تريد نقل البيانات فقط .. أعمل ربط بين القاعدتين عن طريق استيراد الجدول كجدول مرتبط .. ثم يمكنك نقل البيانات بين الجدولين عن طريق استعلام الإلحاق.

35 - عرض رسالة تأكيد بنعم او لا باللغتين العربية والانجليزية. صورة لفهم المحتوى وقاعدة بيانات بها مثال لطريقة العمل . 35 - Msgbox Yer OR No.accdb ولا تنسي ان تسترد الكلاس الموجود لبرنامجك لانه سوف يبني عليه باقي السلسلة . بالتوفيق . كريم الحسيني . هذا هو طلبك انا وبعتذرلك على التأخر فى الرد لظروف العمل وفقك الله دائماً ولا تتردد فى السؤال اى وقت

شكرا لحضرتك

مسار قاعدة البيانات المنسوخ منها مثلاً ("C:\Users\DbName.accdb"). استاذ موسي هذا للنسخ من نفس القاعدة

مرجع التعليمات من مايكروسوفت : https://learn.microsoft.com/en-us/office/vba/api/access.docmd.copyobject

منتظرين نسخة 32 ان شاء الله لكى نرى ابداعات الاستاذ الفاضل / foksh جزاك الله كل خير

لك خالص الشكر هو المطلوب وتم اختياره كافضل اجابه استاذى الفاضل لك الشكر

تفضل استاذ @tharwt المرفق حسب طلبك . سجل رقم الفاتورة وبمجرد تسجيل اسم الصنف سيسجل رقم الصنف بالجدول الاساسي والفورم . اذا كان هذا طلبك لا تنسى الضط على افضل اجابة . New Microsoft Access Database-1.rar

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

السلام عليكم مشاركة مع اخواني .. اخي كريموا : اولا لست بحاجة للفلترة عند فتح التقرير لأن الفلترة حسب الشهر والسنة موجودة فعلا في الاستعلام ثانيا : الرسائل التي تظهر لك بسبب اختلاف تسمية النموذج الفرعي ، ايضا انت تقوم باغلاق النموذج بالكود قبل فتح التقرير .. لذا تظهر الرسائل بالمطالبة بالمعايير ثالثا : انا الغيت بعض الاكواد في حقلين في التقرير لعدم وجود الوحدات النمطية المسؤولة .. ويمكنك كتابتها في برنامجك تفضل مثالك بعد التعديل VermCcp2.rar

تفضل اخي طبق الاتى إليك كيفية تحويل الكود إلى معادلات: 1. في الخلية B2 في ورقة "Report"، استخدم الدالة VLOOKUP للبحث عن القيمة في الخلية A2 من ورقة "AllData" واسترجاع قيمة بداية التاريخ. =VLOOKUP(A2, AllData!$A$2:$E$1000, 3, FALSE) 2. في الخلية C2، استخدم الدالة VLOOKUP مرة أخرى للبحث عن القيمة في الخلية A2 من ورقة "AllData" واسترجاع قيمة نهاية التاريخ. =VLOOKUP(A2, AllData!$A$2:$E$1000, 4, FALSE) 3. في الخلية D2، استخدم الدالة VLOOKUP للبحث عن القيمة في الخلية A2 من ورقة "AllData" واسترجاع قيمة نوع الاجازة. =VLOOKUP(A2, AllData!$A$2:$E$1000, 5, FALSE) تأكد من تغيير نطاق البحث وفقًا لموقع البيانات الخاصة بك في ورقة "AllData 1. افتح برنامج Excel وقم بإنشاء ورقة عمل جديدة. 2. قم بنسخ البيانات الخاصة بك من ورقة "AllData" إلى الورقة الجديدة. 3. في العمود الأول (الخانة A) في الورقة الجديدة، قم بوضع القيم التي تريد البحث عنها في ورقة "AllData". 4. في العمود الثاني (الخانة B)، استخدم الدالة VLOOKUP للبحث عن بداية التاريخ. 5. في العمود الثالث (الخانة C)، استخدم الدالة VLOOKUP للبحث عن نهاية التاريخ. 6. في العمود الرابع (الخانة D)، استخدم الدالة VLOOKUP للبحث عن نوع الاجازة. 7. ضع المعادلات في الصفوف التي ترغب فيها للبحث عن البيانات. هذه الخطوات يمكن أن تنتج نفس النتائج التي يقوم بتحقيقها الكود السابق

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

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

هل تحتاج معادلة ام كود 1. افتح Excel وانقر على الخلية التي ترغب في وضع الصيغة فيها. 2. استخدم الصيغة التالية: حيث أن $A$2:A2 تحدد نطاق البيانات الذي تريد البحث فيه للقيم المكررة، و A2 هو الخلية التي تحتوي على القيمة التي تريد فحصها. 3. اضغط على Enter. هذه الصيغة ستظهر القيمة فقط إذا كانت تظهر للمرة الأولى في النطاق المحدد، وإلا ستظهر خلية فارغة. =IF(COUNTIF($A$2:A2,A2)=1,A2,"") وهذا كود Sub RemoveDuplicatesWithCount() Dim LastRow As Long Dim i As Long Dim UniqueValue As String Dim Count As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To LastRow UniqueValue = Cells(i, 1).Value Count = WorksheetFunction.CountIf(Range("A2:A" & LastRow), UniqueValue) If Count = 1 Then Cells(i, 2).Value = UniqueValue Else Cells(i, 2).Value = UniqueValue & " (" & Count & ")" End If Next i End Sub هذا الكود سيقوم بتطبيق الصيغة وسيظهر القيم المكررة مع عددها في الخلية المجاورة. قم بتنفيذ الخطوات نفسها لإضافة الكود إلى وحدة VBA في Excel وتشغيله.

جرب Private Sub UserForm_Initialize() Dim salesRange As Range Dim cell As Range ' تعيين مجال البيانات Set salesRange = Worksheets("Sheet1").Range("A1:A50") ' قم بتغيير "Sheet1" و "A1:A50" حسب احتياجاتك ' تنسيق البيانات وإضافتها إلى ListBox For Each cell In salesRange ListBox1.AddItem Format(cell.Value, "0.000") Next cell End Sub السؤال الثاني Private Sub ListBox1_Click() Dim selectedCell As Range ' العثور على الخلية المحددة في الصفحة الأصلية Set selectedCell = Worksheets("Sheet1").Range("A1:A50").Find(ListBox1.Value) ' قم بتغيير "Sheet1" و "A1:A50" حسب احتياجاتك ' التأكد من أن الخلية تم العثور عليها If Not selectedCell Is Nothing Then ' التحرك إلى الخلية المحددة selectedCell.Select End If End Sub يمكنك إضافة هذين الكودين إلى مستند Excel باتباع الخطوات التالية: 1. افتح ملف Excel. 2. اذهب إلى "مطور" > "محرر Visual Basic". 3. انقر فوق "إدراج" > "وحدة". 4. قم بلصق الكود في وحدة جديدة. 5. احفظ الملف بامتداد .xlsm. 6. قم بتعيين الوحدة الأولى كـ "UserForm" والوحدة الثانية كـ "ListBox1". 7. أغلق المحرر واستخدم ملف Excel بشكل عادي. لكى تتعلم اخى اتبع ما سبق

لإغلاق جميع النماذج المفتوحة : Do While Forms.Count > 0 DoCmd.Close acForm, Forms(0).Name Loop لإغلاق قاعدة البيانات : docmd.Quit

تلك الصيغة تستخدم في جداول البيانات في ، وتهدف إلى حساب مجموع لأرقام معينة استناداً إلى مجموعة من الشروط. في هذه الحالة، يتم تحديد المجموعة التي تريد جمع أرقامها في "range". ثم يحدد "criteria1" الشرط الذي يجب أن تلبيه الأرقام لتُضاف إلى المجموع، في هذا المثال هو ">100" لاستبعاد الأرقام من 1 إلى 100. وأما "criteria2" فهو الشرط الآخر الذي يجب أن تلبيه الأرقام لتُضاف إلى المجموع، في هذا المثال هو "<=100" لاستبعاد الأرقام من 1 إلى 100.

شكرا جزيلا استاذنا الكبير ( أبو الحسن - محمد هشام ) وربنا يجزيكما كل خير علي تعبكما معنا وشكرا لكل أعضاء المنتدي الكرام

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا الحل هل يناسبك تم وضع كود لجلب البيانات وكود اخر لترحيلها للمكان المناسب على حسب ما فهمت من طلبك Sub Fetch_data() Dim clé As String, SH As String Set desWS = Sheets("رصد درجات") SH = desWS.Range("D1").Value Set f = ThisWorkbook.Sheets(SH) Application.ScreenUpdating = False Tbl = f.Range("C11:R" & f.[c65000].End(xlUp).Row).Value clé = desWS.Range("d3"): colClé = 2 b = arr(Tbl, clé, colClé) If Not IsEmpty(b) Then desWS.Range("C11:R" & Rows.Count).ClearContents desWS.[c11].Resize(UBound(b), UBound(b, 2)) = b Application.ScreenUpdating = True MsgBox "نتائج" & " " & f.Name Else MsgBox "لايوجد نتائج للشرط المعطى" End If End Sub Function arr(Tbl, clé, colClé, Optional Cpt) Dim r() Ncol = UBound(Tbl, 2) If IsMissing(Cpt) Then ReDim r(0 To Ncol - 1): For k = 0 To Ncol - 1: r(k) = k + 1: Next k Else r = Cpt End If Nr = UBound(r) n = 0 For i = LBound(Tbl) To UBound(Tbl) If clé = Tbl(i, colClé) Or clé = "" Then n = n + 1 Next i If n > 0 Then Dim b(): ReDim b(1 To n, 1 To UBound(r) + 1) n = 0 For i = LBound(Tbl) To UBound(Tbl) If clé = Tbl(i, colClé) Or clé = "" Then n = n + 1 For k = 0 To Nr: b(n, k + 1) = Tbl(i, r(k)): Next k End If Next i arr = b End If End Function بيانات التلاميذ 3.xlsm

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

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

التعديل الدي يمكنني اظافته بعد معاينة الملف هو اختصار كود استدعاء الاحتياطي على النحو التالي Sub Compare() Dim lr As Long, i As Long, j As Long Dim strCol As String Dim WS As Worksheet: Set WS = Worksheets("Sheet1") Application.ScreenUpdating = False lr = WS.Columns("A:R").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 'Columns C to R For i = 3 To 18 strCol = Split((WS.Columns(i).Address(, 0)), ":")(0) For j = 5 To lr If WorksheetFunction.CountIf(WS.Range(strCol & "5:" & strCol & lr), WS.Range("A" & j)) = 0 Then WS.Cells(Rows.Count, strCol).End(xlUp).Offset(1).Value = WS.Range("A" & j).Value End If Next j Next i Application.ScreenUpdating = True End Sub بالتوفيق...........

ربما لو قمت بارفاق عينة للنتائج المتوقعة اول مرة وبنفس تنسيق ملفك الاصلي لكنا في غنى عن كل هده المحاولات ووفرت علينا وعلى نفسك الكثير اختيارك لافضل اجابة عند توصلك للحل في اي مشاركة على المنتدى سوف تكون مرجعا لم يحتاجها من بعدك خاصة عند كثرت التعديلات فلا تغفل عنها 😉 الرجاء اخي @2saad أخذ هده الملاحظات بعين الاعتبار في المشاركات المقبلة. Option Explicit Sub test() Dim lr As Long, i As Long, j As Long Dim strCol As String Dim WS As Worksheet: Set WS = Worksheets("Sheet1") Application.ScreenUpdating = False lr = WS.Columns("A:R").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 'الاعمدة من C الى F For i = 2 To 6 strCol = Split((WS.Columns(i).Address(, 0)), ":")(0) For j = 1 To lr If WorksheetFunction.CountIf(WS.Range(strCol & "1:" & strCol & lr), WS.Range("A" & j)) = 0 Then WS.Cells(Rows.Count, strCol).End(xlUp).Offset(1).Value = WS.Range("A" & j).Value End If Next j Next i Application.ScreenUpdating = True End Sub

رسوم.xlsx تفضل اخي الكريم

ادخل عرض التصميم للتقرير ثم حدد الحقل او الحقول التي ترغب تطبيق التنسيق عليها ثم تبويب تنسيق ثم تنسيق شرطي

=currentrecord

الامر يسير 1- نزيل الكود الخاص بادراج التاريخ التلقائي 2- نغير في تنسيق حقل التاريخ في النموذج الى shortDate تم التعديل time3.rar

ابداع .... سلمت أناملك 1- تم التعديل لتظهر الساعات والدقائق 2- لا ينصح بالتجميع داخل الجداول علما ان الاصدارات الجديدة تشتمل على حقول خاصة بالتجميع ويمكنك استخدام الاستعلام الموجود كمصدر للبيانات بدلا من الجدول 12 ظهرا تكتب الواحدة مساء وتاريخ اليوم 24 بعد منتصف الليل تكتب الواحدة صباحا وتاريخ يوم غد اشكرك جزيل الشكر استاذ ماشاءالله ربنا يزيدك من علمه يارب سؤال آخر: اذا اردت ان ادخل كلا من (تاريخ بدء العطل وتاريخ انتهاء العطل) يدويا والنتيجة فقط تظهر لي في خانة الفارق كيف اعمل هذا بمعنى لا اريد ان يظهر التاريخ تلقائيا بعد ادخل الوقت اريد ان ادخل التاريخ ايضا يدويا.