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

أعتقد أن الكود سهل في التعديل خاصة بعدما تم توضيح النقط المهمة لدالك صراحة لا أعلم ما تحاول فعله لاكن يمكنك جعل الكود مرن بدون تقييد للنطاقات إدا كنت بحاجة دائمة لإظافة أعمدة جديدة بحيث يمكنك تحديد أول عمود فقط داخل الكود وترك أخر عمود للبيانات تلقائي بحسب الأعمدة المتاحة لديك startRow = 7 ' أول صف للبيانات headerRow = 6 ' رقم صف عناوين رؤوس الأعمدة startCol = 5 ' أول عمود للبيانات المنسوخة ' العثور على اخر عمود endCol = WS.Cells.Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column With WS endRow = .Cells(.Rows.Count, startCol).End(xlUp).Row a = .Range(.Cells(startRow, startCol), .Cells(endRow, endCol)).Value End With Dim h As Variant ReDim headers(1 To UBound(a, 2)) h = WS.Range(WS.Cells(headerRow, startCol), WS.Cells(headerRow, endCol)).Value For i = 1 To UBound(a, 2) headers(i) = h(1, i) Next i colArr = Array(3, 4) ' المورد (G) والصنف (H) الزرع v5.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك إضافة قاعدة بيانات لأسماء الفرق والشعارات الخاصة بها في ورقة جديدة وتسميتها مثلا Logos واستخدام الكود التالي في حدث ورقة GroupA لتغيير الشعار تلقائيا بناء على التغيير في النتيجة عندما يتم نقل إسم الفريق في الورقة (أي تغيير موضع الخلية) سيتحرك الشعار إلى الموقع الجديد بشكل تلقائي كما في الصورة أدناه Option Explicit Private Sub Worksheet_Calculate() Dim tmp As Range, n As Shape, OnRng As Range Dim crWS As Worksheet: Set crWS = Me Dim dest As Worksheet: Set dest = Sheets("Logos") Application.ScreenUpdating = False For Each tmp In crWS.Range("J14:J" & crWS.Cells(crWS.Rows.Count, "J").End(xlUp).Row) If tmp.Value <> "" Then For Each n In crWS.Shapes If n.Type <> 8 And n.TopLeftCell.Address = tmp.Offset(0, -1).Address Then n.Delete Next n Set OnRng = dest.Range("A2:A" & dest.Cells(dest.Rows.Count, _ "A").End(xlUp).Row).Find(tmp.Value, LookAt:=xlWhole) If Not OnRng Is Nothing Then For Each n In dest.Shapes If n.TopLeftCell.Address = dest.Cells(OnRng.Row, _ dest.Range("A2:A" & dest.Cells(dest.Rows.Count, "A").End(xlUp).Row).Column + 1).Address Then n.Copy tmp.Offset(0, -1).Select ActiveSheet.Paste With Selection.ShapeRange .LockAspectRatio = msoFalse .Left = tmp.Offset(0, -1).Left + 4: .Top = tmp.Offset(0, -1).Top + 5 .Width = tmp.Offset(0, -1).Width - 8: .Height = tmp.Offset(0, -1).Height - 6 End With Selection.ShapeRange(1).Select Selection.ShapeRange(1).TopLeftCell.Select End If Next n Else For Each n In crWS.Shapes If n.Type <> 8 And n.TopLeftCell.Address = tmp.Offset(0, -1).Address Then n.Delete Next n End If End If Next tmp Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تجريبة v2.xlsb

شكرا جزيلا ... زادكم الله علما

وعليكم السلام ورحمة الله وبركاته .. مشاركة مع الاستاذ @أبوبسمله جرب التالي ايضاً ..

هل جربت التجميع

جزاك الله خيرا استاذ @Foksh وبارك الله فيك وارجو اضافتي في مجموعة الواتس اب

المشكلة في التحقق كان الكود يتحقق من كل سجلات المنخرط سواءا كانت مدفوعات او انخراط ' التحقق من المدفوعات السابقة مع تصفية `wada3 = "تم الإنخراط"` If Month(Now()) = 3 Then PaymentCheck = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " AND [Payment_Month] BETWEEN #" & DateSerial(SelectedYear, 1, 1) & "# AND #" & DateSerial(SelectedYear, 2, 28) & "# AND [wada3]='تم الإنخراط'"), 0) Else PaymentCheck = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " AND [Payment_Month] BETWEEN #" & DateSerial(SelectedYear, 4, 1) & "# AND #" & DateSerial(SelectedYear, 6, 30) & "# AND [wada3]='تم الإنخراط'"), 0) End If

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

السلام عليكم ورحمة الله وبركاته أستاذ جربت الكود الأخير لكن أيضا طلع run-time error '5' لذلك انا خليت هذا الـــerror number '5' في هذا الكود If Err.Number = 5 Then MsgBox "سجل مكرر! لا يمكنك ادخال نفس البيانات مرتين", vbExclamation + vbMsgBoxRight, "تنبيه", Cancel = True Else MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, "الاسم مكرر! لايمكنك ادخال نفس البيانات مرتين" End If والحمد لله مشي الحال ، لكن أستاذ هو ما يطلع اول رسالة لوجود التكرار وإنما يطلع ثاني رسالة الي هي " حدث خطأ " لذلك قمت بوضع الاسم مكرر في ثاني رسالة كما في الصور . الحمد لله مشي الحال شكرا جزيلا لك أستاذ على تعبك معاي ، ممنون منك

تسلم اخوي عاشت ايدك

وعليكم السلام ورحمة الله وبركاته Null

جرب On Error GoTo hoh DoCmd.Save DoCmd.GoToRecord , , acNewRec Me.Instructor_ID.SetFocus hoh: If Err.Number = 2105 Then MsgBox "سجل مكرر ! لا يمكنك إدخال نفس البيانات مرتين", vbExclamation + vbMsgBoxRight, "تنبيه" Cancel = True Else MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, "خطأ" End If

الشكر لله و جزاك الله هو نفس ملف يبدل القديم على الجديد و في تعدديل جديد تم اضافة تاريخ و الوقت تصدير الى اسم الملف يصدر كل ملف على اسم مختلف الا تصدير ملفين في نفس دقيقة، باضافة تعديل فتح ملف بعدد تصدير احذفت عمود Q و لا حاجة له لان كيو آر كود يأخذ رابط من حقل (رابط يوتيوب) أنشطة 2025 (A).xlsb

السلام عليكم الأخوة المبتدئين في برمجة اكسس هذا اقتطته من برنامج عملاق لأحد الاخوة المبرمجين وهو مقدم هدية مجانية اضعه بين ايديكم للاستفادة منه من حيث التصميم ومن حيث الاكواد وهو نسخة مجانية وليس مخصص للبيع 1- تعبئة بيانات الشركة الخاصة بك 2- تعبئة بيانات الموردين 3- تعبئة سيندات الدفع جربوه ووافوني بالنتائج SANADAT 2025.accdb

I CHANGE THE LANGUAGES TO ENGLISH BEST WISHES SANADAT 2025.rar

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

وعليكم السلام ورحمة الله وبركاته ،، اعتقد ان حل مشكلتك يعتمد على رقم هذا الخطأ في آكسيس ، وإن ما خاب ظني Err.Number = 3022 ، ولكن للتأكيد تستطيع جلب قيمة رقم رسالة الخطأ من خلال الفكرة التالية للتأكد :- في زر الحفظ على سبيل المثال ، اكتب في نهاية الكود :- MsgBox Err.Number وعليه اذا حصلت على رقم خطأ مختلف عن 3022 ، فاستبدله و استعمل الكود التالي على سبيل المثال لتغيير رسالة الخطأ :- If Err.Number = 3022 Then MsgBox "سجل مكرر ! لا يمكنك إدخال نفس البيانات مرتين", vbExclamation + vbMsgBoxRight, "تنبيه" Cancel = True Else MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, "خطأ" End If طبعاً هذا على سبيل المثال لا الحصر ، والكثير من الأفكار قد تعمل نفس النتيجة أخي الكريم ..

كل حسب نسبته المشارة امامه ولو امكن ان تبقى الاسهم باتجاه واحد بدون تغيير

مخازن كامل باس ورد 0 الثلاجات مخازن 20215.rar

نعم صدقت وفاتنى ذلك تعديل الملف BIOCHEMICAL TEST1.xlsb

محاولتي معالجة بيانات الحضور تحتاج غالبا إلى تدخل يدوي، هذا ما استطعت عمله. AttendanceIII_01.xlsm

كلام غير دقيق، نعم في شفرتي هناك مشكلة واحدة لاختلاف في دالة التنسيق بين الإكسل والبيزك، ففي الإكسل "General" تكون في الأكسس "General Number" وهذا سبب بخطأ واحد فقط لرقم 52 والحل إما بعمل تبديل التنسيق للخلية أو تبديله في الشفرة أو نأخذ قيمة Text بدلا من Value للخلية المصدر. كما أنصحك بترك التفاضل بين الخبراء لأننا خضنا معركة كبيرة مع مالك الموقع لتجنب هذا التفاضل بتغيير الوصف من "أفضل إجابة" إلى "تمت الإجابة"، فغالبا تكون بها غبن للآخرين، فالأستاذ عبدالله أسس للكود وقبل طلبك الأخير باستخدام التنسيق، وكذلك الأستاذ محمد هشام قدم حله بعد اطلاعه على الحلين السابقين واستفاد من المقارنة وقد عدل مرفقه بعدها. لا يهمني اختيار جوابي كما فعلت ولا يعني ملاحظتي لك التقليل من جهد أساتذتي فإن أمكنك إعطاء الاختيار لأحد أساتذتي فافعل.

جرب هذه المحاولة بعد الإضافة على كود الأستاذ عبدالله حسب طلبك الأخير. DATA_05.xlsb

بإذن الأستاذ عبدالله ضع سجل البداية في متغير يحميك من الأخطاء: firstRow = 5 'السجل المطلوب For rowIndex = firstRow + 1 To lastRow names = "" For colIndex = 2 To 13 If ws.Cells(rowIndex, colIndex).Value <> "" Then names = names & IIf(names = "", "", " - ") & ws.Cells(firstRow, colIndex).Value End If Next colIndex ws.Cells(rowIndex, 14).Value = names Next rowIndex

السلام عليكم 🙂 هذه طريقتي لتفكيك الحقل الى حقول 🙂 نأخذ المرفق كالمثال من هذا الرابط : . هكذا تبدو السجلات ، بالعين المجردة : . والمطلوب ان نقسم بيانات السجل الواحد الى: الاسم ورقم التسلسل (وخلينا نستخدم السجل الاول كمثال) ، ونريد النتيجة تكون : . هناك طريقتين لفرز هذه البيانات : عن طريق كود ليقرأ الحروف/الارقام/العلامات واحدا واحدا ، ثم بوضع شروط اذا جصلنا على رقم ، فنتوقف ونحفظ الجزء الاول ، ثم نواصل ... ، وهذه العملية مرهقة وتحتاج الى تفاصيل كثيرة ، عن طريق الكود ، ولكن بإستخدام الدالة Split ، ويشترط فيها ان نعرف اين (بعد اي حرف/رقم/علامات) نقسم السطر ، ولنسمية شرط القطع . سنتعامل مع الطريقة الثانية وهي الاسهل 🙂 لمعرفة شرط القطع ، يمكننا ان نتعامل مع الحروف/الارقام/العلامات مباشرة ChrW ، او نتعامل مع ارقام هذه (الحروف/الارقام/العلامات) AscW ، وانا لا استغني عن هذه الصورة المرفقة لعملي ، الحرف Chr ، ومقابله رقمه Dec : . وبالنسبة للحروف العربية ، هذا رابطها : https://sites.psu.edu/symbolcodes/languages/mideast/arabic/arabicchart/ او https://www.ssec.wisc.edu/~tomw/java/unicode.html#x0600 وقد قمت باخذ البيانات من الموقع ورتبتها في صفحة واحد : فمثلا اول حروف اسم ابراهيم : ا = 1575 ، ب = 1576 ، ر = 1585 ، بمعنى AscW(ا) = 1575 , AscW(ب) = 1576 , AscW(ر) = 1585 والعكس يكون ChrW(1575) = ا , ChrW(1576) = ب , ChrW(1585) = ر . للحصول على الاسم ، نريد ان يكون لدينا شرط القطع بعد الاسم وقبل بداية الرقم (اي في المنطقة 1) ، للحصول على التسلسل ، نريد ان يكون لدينا شرط القطع بعد التسلسل وقبل بداية الاسم التالي (اي في المنطقة 2) ، لمعرفة شرط القطع يجب علينا ان نحلل البيانات التي يراها الكمبيوتر ، وذلك بتحويل الحروف/الارقام/العلامات الى AscW ، هذا الكود يقوم بهذه العملية: Public Function Split_Names() Dim rst As DAO.Recordset Dim x() As String Dim i As Long Dim a As String Set rst = CurrentDb.OpenRecordset("Select * From MyTxt_from_pdf") Do Until rst.EOF For i = 1 To Len(rst!Field1) a = Mid(rst!Field1, i, 1) 'الحروف/الارقام/العلامات a = a & "(" & AscW(a) & ") " 'رقمها AscW Debug.Print a Next i Loop rst.Close: Set rst = Nothing End Function ونناديه من نافذة الكود هكذا (يجب ان يكون الكيبور باللغة الانجليزة عند كتابة علامة الاستفهام) : . ونرى ان النتيجة للسجل الاول فقط : . وبعد التدقيق ، نلاحظ ان في نهاية الارقام نرى ان AscW التالية متكررة 8236 ثم 8236 ثم 32 ثم 32 ، وبذلك يمكننا استعمال هذه كشرط القطع بعد الاسم ا(1575) ق(1602) ل(1604) ح(1581) ا(1575) د(1583) م(1605) ح(1581) ي(1610) ا(1575) م(1605) و(1608) د(1583) د(1583) س(1587) ه(1607) ?(8236) ?(8236) ?(8236) -32 -32 -32 -32 -32 -32 . بعد الرقم 3(1635) 2(1634) ?(8236) ?(8236) ?(8236) ?(8236) -32 -32 -32 -32 . وعليه نستعمل هذا الكود ، ونرى نتيجته (للسجل الاول) : Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) Debug.Print x(i) Next i rst.MoveNext Loop ونتيجته ?ابراهيم احمد يحيى احمد? ??3 ?ابتهاج سامح نسيم اقلديوس? ??2 ?ابتسام محمد عبدا حماده? ??1?? . والآن خلينا نفكك الاسم من الرقم : Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) 'Debug.Print x(i) x2 = Split(x(i), ChrW(8236) & ChrW(32) & ChrW(32)) For j = LBound(x2) To UBound(x2) Debug.Print x2(j) Next j Next i rst.MoveNext Loop والنتيجة ?ابراهيم احمد يحيى احمد ??3 ?ابتهاج سامح نسيم اقلديوس ??2 ?ابتسام محمد عبدا حماده ??1?? . ونلاحظ من القائمة اعلاه ، ان علامات الاستفهام ارقامها ?(8235) ?(8234) ?(8236) . الخطوة الاخيرة هي تنظيف النتيجة من علامات الاستفهام هذه عن طريق الامر Replace ، والتخلص من المسافة الزائدة قبل وبعد النتيجة عن طريق الامر Trim ، وبعدها نريد ان نحفظ الاسم في اول حقل ، والرقم في الحقل الثاني: LBound دائما تساوي صفر Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) 'Debug.Print x(i) x2 = Split(x(i), ChrW(8236) & ChrW(32) & ChrW(32)) For j = LBound(x2) To UBound(x2) 'Debug.Print x2(j) a = Replace(x2(j), ChrW(8234), "") a = Replace(a, ChrW(8235), "") a = Replace(a, ChrW(8236), "") a = Trim(a) 'If j / 2 = Int(j / 2) Then If j = 0 Then 'even Debug.Print "Name: ", a Else 'odd Debug.Print "ID: " & a End If 'Debug.Print a Next j Next i rst.MoveNext Loop والنتيجة Name: ابراهيم احمد يحيى احمد ID: 3 Name: ابتهاج سامح نسيم اقلديوس ID: 2 Name: ابتسام محمد عبدا حماده ID: 1 Name: احمد السيد على محمد ID: 6 Name: ابراهيم كمال ابراهيم محمد ID: 5 Name: ابراهيم سمير عياد عطاا ID: 4 Name: احمد حسن احمد رسلن ID: 9 Name: احمد حجازى على محمد ID: 8 Name: احمد السيد محمد عبدالرحمن ID: 7 . -------------------------------------------------------- وفي سياق هذا الموضوع ، كان عندي مشروع القرآن الكريم ، وحفظه في قاعدة البيانات بعدة طرق: كل صفحة عبارة عن سجل ، وفي جدول آخر ، كل سطر في سجل ، وفي جدول آخر ، كل آية في سجل وقمت بتنزيل القرآن الكريم من مجمع الملك فهد لطباعة المصحف الشريف : https://fonts.qurancomplex.gov.sa/wp02/حفص والمرفق يحتوي على الخط العثماني ، والذي تم عمله في المجمع ، ولذا فهو يحتوي على حروف/ارقام/علامات AscW تختلف عن غيرها من الخطوط ، والطريقة الوحيدة لتفكيك الاسطر كانت بإتباع خطوات شبيهه بالخطوات اعلاه 🙂 جعفر

تفضل برنامج الشيكات.xlsx

اي استاذ ماينفعش هكذا ادخل على التقرير مباشرة وادخل التاريخ 2025/03/01 وسترى النتيجة