كل الانشطه

تفضل ,, افتح الاستعلام Query2 باركود نهائي.accdb

هل ممكن الملف بعد التعديل لكي احمله على الكمبيوتر

جميل جداً بارك الله بجهودك وأكرمك الله

حاولت تصور الفكرة ولم افهم بالضبط المطلوب للإحتياط ، هل الاستعلام التالي يفي بالغرض :- SELECT St_Code & Switch([StudyMaterialsEng]="ARABIC","ARA",[StudyMaterialsEng]="ART","ART",[StudyMaterialsEng]="ENGLISH","ENG",[StudyMaterialsEng]="MATH","MAT",[StudyMaterialsEng]="RELIGION","REL",[StudyMaterialsEng]="SCIENCE","SCI",[StudyMaterialsEng]="SOCIAL","SOC",[StudyMaterialsEng]="SPORT","SPO") AS Barcode, Query1.St_Code, Query1.St_Name, Query1.St_Group, Query1.StudyMaterialsEng FROM Query1 ORDER BY Switch([StudyMaterialsEng]="ARABIC",1,[StudyMaterialsEng]="ART",2,[StudyMaterialsEng]="ENGLISH",3,[StudyMaterialsEng]="MATH",4,[StudyMaterialsEng]="RELIGION",5,[StudyMaterialsEng]="SCIENCE",6,[StudyMaterialsEng]="SOCIAL",7,[StudyMaterialsEng]="SPORT",8), Query1.St_Code; تم اضافة عمود جديد في الاستعلام لمسميات التخصص أو المواد ، وتم الفرز من خلالها ..

رداً للجميل في هذا المتدى المتميز، أرفق إليكم هذا الملف لإدارة الميزانية الشخصية، والذي استخدمت فيه دالة pivotable ودمجتها بدالة filter ، وتم عرض الملف بداش بورد جميل ومرتب.. تحياتي للجميع. Files.zip

كل الشكر والتقدير لكل من kkhalifa1960 Foksh رسالة الخطأ التى تحدثت عنها فى بداية الموضوع لا تؤثر فى عمل النموذج وتعتبر شيئاً زائداً فى بعض الأحيان لكن استفدت منكما فى معرفة سببها لذلك لن أقوم بالتعديل حالياً ، فالوضع الحالى بدون تعديل هو الأفضل مرة أخرى .. شكراً جزيلاً لكما

بخدمتك استاذي هل الأن العنوان مناسب لكن لا أعلم هل شرحي واضح ام لا

اخواني جزاكم الله كل خير واستاذي الكريم kkhalifa1960 هذا الجواب الصحيح استاذ Foksh اشكرك جزيل الشكر للتوضيح ولكم جميعا كل الاحترام والتقدير

للأسف لا أعلم هذه المعلومة ، فأساليب حذف السجلات تختلف حسب فكر المبرمج وصانع الأكواد ،، ولكن تماشياً مع فكرتك ، سنقوم بجعل الكود يتأكد مما اذا كان هناك سجل بعد السجل الحالي المستهدف حذفه ، فإن كان هناك سجل فيتم الانتقال اليه ، وإذا كان السجل المطلوب حذفه هو آخر سجل فسيتم الانتقال الى سجل جديد بعد اتمام عملية الحذف .. استبدل كودك السابق بهذا الكود لزر حذف السجل :- Private Sub Cmdel_Click() On Error GoTo Err_Cmdel_Click If MsgBox(":ستقوم الآن بحذف السجل المسجل بملف رقم" & vbCrLf _ & vbCrLf _ & [Nr] & " " & vbCrLf _ & [Name_T] & vbCrLf _ & " " & vbCrLf _ & "هل أنت متأكد ؟" & vbCrLf _ & "أضغط ( نعم ) للإستمرار ، أو ( لا ) لإلغاء الأمر", _ vbQuestion + vbYesNo + vbMsgBoxRight, "تحذيـــر") = vbYes Then Dim rs As DAO.Recordset Set rs = Me.RecordsetClone rs.Bookmark = Me.Bookmark rs.Delete ' بعد الحذف ، سيتم التحقق مما اذا كان هناك سجل لا حق أم لا If Not rs.EOF Then rs.MoveNext If Not rs.EOF Then Me.Bookmark = rs.Bookmark Else ' لا يوجد سجل بعده - انتقل إلى سجل جديد DoCmd.GoToRecord , , acNewRec End If Else ' لا يوجد سجلات بعد الحذف - انتقل إلى سجل جديد DoCmd.GoToRecord , , acNewRec End If rs.Close Set rs = Nothing End If Exit_Cmdel_Click: Exit Sub Err_Cmdel_Click: MsgBox Err.Description, vbExclamation + vbMsgBoxRight, "خطأ" Resume Exit_Cmdel_Click End Sub أما بالنسبة للأسباب :- فالمشكلة التي تحصل معك سببها أنه وبعد اجراء عملية الحذف ، فإن اكسيس تلقائياً يقوم بالانتقال إلى السجل التالي ( MoveNext ) لكن !!! وبما أنه لا يوجد سجل تالي ، هنا قد يحدث خطأ أو يبقى النموذج " بدون سجل " ، مما يسبب تجميد أو ظهور نموذج فارغ أو حتى خطأ غير متوقع.

نرجو منك الاهتمام باختيار عنوان مناسب لمواضيعك ، بحيث يشرح المشكلة كعنوان بشكل واضح .

اضف ماسج وتحديث بنهاية كود الحذف . Private Sub Cmdel_Click() On Error GoTo Err_Cmdel_Click If MsgBox(":ستقوم الآن بحذف السجل المسجل بملف رقم" & vbCrLf _ & vbCrLf _ & [Nr] & " " & vbCrLf _ & [Name_T] & vbCrLf _ & " " & vbCrLf _ & "هل أنت متأكد ؟" & vbCrLf _ & "أضغط ( نعم ) للإستمرار ، أو ( لا ) لإلغاء الأمر", vbQuestion + vbYesNo _ + vbMsgBoxRight, "تحذيـــر") = vbYes Then Me.Recordset.Delete Me.Recordset.MoveNext End If MsgBox "تم حذف السجل بنجاح", vbExclamation Me.Requery Exit_Cmdel_Click: Exit Sub Err_Cmdel_Click: MsgBox Err.Description Resume Exit_Cmdel_Click End Sub

يعمل بشكل طبيعي .... طالع .

شكراً أخى لاهتمامك وردك سوف أضع مرفق للملف الذى أعمل عليه أدناه أحياناً الفورم يعمل بدون مشاكل بالمرة ، وفى بعض الأحيان تكون المشكلة فى حذف السجل الأخير لكن أرجو أن تضيف سجل جديد باستخدام أحد الأرقام القومية الآتية 26507111201809 أنثى 28603110400251 ذكر 27301052700568 أنثى 27908100400212 ذكر 28101200400409 أنثى والخروج من خانة الرقم القومى بعد لصقه بالضغط على زر Tab ثم قم بحذف هذا السجل .. المفترض بعد الحذف وجود صفحة بيضاء خالية من كل الحقول الغير منضمة لكن هذا لا يحدث دائماً db1.mdb

السلام عليكم يا مبدعين أحتاج فقط تعديل( ترتيب ) كود الباركود التعديل يكون فقط ترتيب باركود المواد الدراسية يعني حسب المواد وليس حسب الطالب مثلا باركود التربية الإسلامية 1) احمد 2) ادم باركود اللغة العربية 1) احمد 2) ادم باركود اللغة الانكليزية 1) احمد 2) ادم باركود الرياضيات 1) احمد 2) ادم باركود العلوم 1) احمد 2) ادم باركود الاجتماعيات 1) احمد 2) ادم باركود التربية الفنية 1) احمد 2) ادم باركود التربية الرياضية 1) احمد 2) ادم الترتيب يكون حسب المواد الدراسية في عمود الباركود باركود نهائي.rar

الله يبارك فيك استاذي كلمة شكرا قليلة على حضرتك انت تاج الرأس

يبدو أن الخطأ الذي يظهر لك هو "This action was cancelled by an associated object." في Access عند محاولة حذف السجل باستخدام الكود. هذا قد يكون بسبب أحد الأسباب التالية: السجل مرتبط بكائن آخر: إذا كان السجل المحذوف مرتبطًا بجدول آخر عبر علاقة عدم السماح بالحذف المتتالي (مثل مفتاح أجنبي)، فقد يؤدي ذلك إلى إلغاء العملية. نموذج غير قابل للتحديث: إذا كان النموذج مبنيًا على استعلام غير قابل للتحديث، فقد لا يتم تنفيذ عملية الحذف بشكل صحيح. مشكلات في Recordset: استخدام Me.Recordset.Delete قد لا يكون الطريقة المثلى لحذف السجلات في بعض الحالات، خاصة إذا كان مصدر النموذج لا يدعم الحذف المباشر. تعامل غير صحيح مع الأخطاء: الكود يقوم بتنفيذ Resume Exit_Cmdel_Click بعد عرض رسالة الخطأ، مما قد يؤدي إلى تجاهل المشكلة دون التعامل معها بوضوح. الحلول الممكنة: استخدم DoCmd.RunCommand acCmdDeleteRecord بدلًا من Me.Recordset.Delete لتجربة طريقة حذف أخرى: If MsgBox("هل أنت متأكد من حذف السجل؟", vbQuestion + vbYesNo, "تحذير") = vbYes Then DoCmd.RunCommand acCmdDeleteRecord End If تحقق من العلاقات: إذا كان هناك جداول مرتبطة، جرب حذف السجل يدويًا من الجدول الرئيسي لمعرفة ما إذا كان هناك قيود تمنع الحذف. جرب Requery بعد الحذف: قد تحتاج إلى تحديث النموذج بعد الحذف لضمان تنفيذ العملية: Me.Requery

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

تفضل استاذ @محمد119900 تم اضافة زر التصدير لاكسل بالفورم (frmMain) ومجرب ويعمل تمام ويرفق ملف الكسل بجوار القاعدة . جربه . ووافني بالرد . DDMhamed(4).rar

لا اعلم ما الفرق اذا كانت الأعداد في اعلى التقرير او اسفله ولكن رب ضارة نافعة اخذنا في منحنى آخر ... بدأنا من الصفر الطريقة الجديدة للتعامل مع البيانات بعيدا عن محرر الأكواد الاعتماد كليا على الاستعلامات والجداول المؤقتة .... تم عمل كشف النصف الأول لجميع الصفوف انظر السرعة في التقرير وكأنك تتصفح الجدول ... موضوعك الحالي خاص بالدرجات .. ولا زال امامك طريق حتى تصل حاول تطبيق العمل واستنساخه واعمل النصف الثاني Database63.rar

تفضل استاذ @محمد119900 المرفق بطلباتك كامل ومجرب ويعمل تمام . ووافني بالرد . DDMhamed(3).rar

تفضل استاذ @ahmadhurira المرفق بعد التعديل بطلبك حسب ما فهمت .بثلاث طرق كل طريقة بنموذج.اليك الشرح والمرفق .ووافني بالرد . Database4-2.rar

من المفروض أولا كما سبق الدكر محاولة إلغاء دمج الخلايا لضمان أن الكود يتعامل مع كل خلية على حدة وحصولك على نتائج صحيحة جرب هدا هل يناسيك Option Explicit Public Sub Add_CheckBoxes() Dim tbl As Long, cb As OLEObject, OnRng As Range, ky As Variant Dim dataArray() As String, Search As String, n As Boolean Dim i As Long, lastRow As Long, col As Long, lastCol As Long Dim kys() As String Dim CrWS As Worksheet: Set CrWS = Sheets("MenuF") Dim dest As Worksheet: Set dest = Sheets("main sheet") Search = Trim(CrWS.Range("B1").Value) If Search = "" Then: MsgBox "يرجى إدخال قيمة البحث", vbExclamation: Exit Sub lastRow = dest.Cells(dest.Rows.Count, "A").End(xlUp).Row n = False For i = 2 To lastRow If Trim(dest.Cells(i, 1).Value) = Search Then tbl = i n = True Exit For End If Next i If Not n Then: MsgBox "قيمة البحث غير موجودة على قاعدة البيانات", vbExclamation: Exit Sub lastCol = dest.Cells(tbl, Columns.Count).End(xlToLeft).Column ReDim dataArray(1 To lastCol - 1) For col = 2 To lastCol dataArray(col - 1) = Trim(dest.Cells(tbl, col).Value) Next col For Each cb In CrWS.OLEObjects If TypeName(cb.Object) = "CheckBox" Then cb.Object.Value = False Next cb For Each OnRng In CrWS.Range("A3:I7") If OnRng.Value <> "" Then kys = Split(Replace(OnRng.Value, "،", ","), ",") For Each ky In kys For i = LBound(dataArray) To UBound(dataArray) If CompareValues(tmp(dataArray(i)), tmp(ky)) Then For Each cb In CrWS.OLEObjects If TypeName(cb.Object) = "CheckBox" Then If cb.TopLeftCell.Address = OnRng.Address Then cb.Object.Value = True Exit For End If End If Next cb End If Next i Next ky End If Next OnRng End Sub Private Function tmp(ByVal txt As String) As String tmp = Replace(Replace(Trim(txt), " ", " "), "ال", "") End Function Private Function CompareValues(val1 As String, val2 As String) As Boolean CompareValues = (InStr(1, val1, val2, vbTextCompare) > 0 Or InStr(1, val2, val1, vbTextCompare) > 0) End Function لتلوين القيم CrWS.Range("A3:I7").Font.Color = vbBlack For Each OnRng In CrWS.Range("A3:I7") If OnRng.Value <> "" Then kys = Split(Replace(OnRng.Value, "?", ","), ",") For Each ky In kys For i = LBound(dataArray) To UBound(dataArray) If CompareValues(tmp(dataArray(i)), tmp(ky)) Then For Each cb In CrWS.OLEObjects If TypeName(cb.Object) = "CheckBox" Then If cb.TopLeftCell.Address = OnRng.Address Then cb.Object.Value = True Exit For End If End If Next cb OnRng.Font.Color = vbRed End If Next i Next ky يمكنك إختيار ما يناسبك فورمة - V4.xlsb

ومشاركة مع أخي @kkhalifa1960 ، هذه فكرتي ، بحيث من خلال دالة عامة يمكن استخدامها في أي مكان في المشروع وليس ضمن حقل معين أو نموج معين .. انشئ مديول جديد أو في مديول موجود ، وألصق الكود التالي :- Public Function CalculateTax(ByVal salary As Double) As Double Const BASE1 As Double = 750 Const BASE2 As Double = 1166.667 Const FIXED_TAX_AT_BASE2 As Double = 28.883 Select Case True Case salary < BASE1 CalculateTax = 0 Case Round(salary, 3) = BASE2 CalculateTax = FIXED_TAX_AT_BASE2 Case salary < BASE2 CalculateTax = (salary - BASE1) * 0.05 Case Else CalculateTax = FIXED_TAX_AT_BASE2 + (salary - BASE2) * 0.1 End Select End Function ثم في حدث بعد التحديث لمربع نص "الراتب" :- Me.الضريبة = CalculateTax(Me.الراتب) وكنصيحة مستقبلية من أخ لأخيه المسلم :- ابتعد عن التسميات العربية للحقول والعناصر ومكونات قاعدة البيانات ، فحتماً ستسبب لك العديد من المشاكل في المشروع والتنفيذ .