كل الانشطه

. هناك عدة طرق للتعامل مع هذا التأخير: أ. يجب اعادة النظر في الاستعلام ، ومن متابعتي لردودك ، فأنت عندك هوس/ولع غير طبيعي في الكود ، بينما الاستعلام هو العمود الفقري لقواعد البيانات ، وهو الاسرع. فيجب النظر في تحويل الكود الى استعلامات ، وقد يكون عليك استبدال الكود الواحد الى استعلام واحد اثنين عشرة ... لا يهم ، المهم هو سرعة البرنامج ، ب. يجب عليك تصدير نتائج هذا الاستعلام الى جدول ، ويكون الجدول هو مصدر بيانات النموذج/التقرير ، فالتأخير سيكون مرة واحدة فقط (عند تصدير الاستعلام ومعالجته الحسابات المعقدة ، الى الجدول) : بما ان الاكسس لا يستطيع عمل اكثر من شيء واحد في نفس الوقت ، اي انه ينتظر حتى تكتمل عمليه معينة ، حتى يقوم بعملية اخرى. مثلا ، اذا اردت عند فتح البرنامج ان يقوم اكسس بتصدير بيانات اسنعلامك البطئ الى جدول ، فعند نقرك زر التصدير ، فلا تستطيع عمل شيء آخر في الاكسس الى ان ينتهي العمل من التصدير ، لذا وبعد النقر على زر التصدير ، اظهر رسالة للمستخدم بترك البرنامج يعمل ، ولما ينتهي البرنامج من التصدير ، تستطيع استخدامه (اعطيه فرصة يشرب قهوة الصباح 🙂 ). الطريقة الاخرى ، والتي لن تجد احد يتكلم عنها (لأنها غير مألوفة) ، بأن تشغل برنامج اكسس آخر (رقم2) والذي فيه الاستعلام البطئ ، فيشغل الاستعلام بأخذ بياناته من برنامجك ، وتصدير البيانات الى جدول ، وفي هذا الوقت وبينما يعمل رقم2 ، يستطيع مستخدمين رقم1 من العمل بطريقة عادية ، ثم يستعملون بيانات الجدول. بمعنى آخر ، اجعل البرامج تشتغل بطريقة متوازية. ولكني اعتقد ان حل التأخير في النقطة أ. وبعد اتباع الطريقة الصحيحة في الاستعلام ، معظم تأخير الاستعلامات هي في الفرز والتصفية ، وحتى اذا عملت فهرسة لحقل ثم في الاستعلام استعملت بيانات الحقل بطريقة اخرى ، فانت في الواقع لا تستعمل فهرست الحقل ، مثلا عندك حقل تاريخ مفهرس myDate ، ثم قمت في الاستعلام بطلب السنة: Y: Year([myDate]) وعملت له فرز او تصفية لسنة معينة (مثلا 2010) ، فانت في الواقع لا تستفيد من فهرست الحقل ، لذا فالحل هو استعمالك التاريخ كما هو في الحقل ثم عمل التصفية بنفس طريقته ، مثل: myDate>31-12-2009 and myDate<1-1-2011

الاخوة الكرام الافاضل السلام عليكم ورحمة الله وبركاته كنت بدات في برنامج مرتبات موظفين بنظام الشيت اليومي والاخ الفاضل المعلم @kkhalifa1960 لكن ظهرت مشكلة مش عارف احلها وحاولت بس للاسف موصلتش المشكلة ان لما بعمل انتداب لفرد بعدد ايام معينة المفروض انها تسمع بقيمة الايام دي (صورة رقم 2) في اجمالي الراتب طبعا اللي في شاشة المرتبات من قائمة التشغيل صورة رقم 3 ياريت المساعدة ضروري من فضلكم نظرا لحكم البرنامج انا وضعته في اللينك التالي https://www.mediafire.com/file/1ii47pkl6x06n6g/samer-Test222.rar/file

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

تفضل https://www.youtube.com/@Emad_ghazi

يبدو اننى لم استطع صياغة السؤال بشكل مفهوم انا اقصد انه تتم عملية حسابية معقدة تستغرق مثلا من دقيقتين الى ثلاث دقائق معنى هذا انه سوف يتم استغراق نفس الوقت لعدد السجلات التى سوف يتم عرضها يعنى مثلا كل 27 او 30 سجل تحدث هذه العمليات اتستغرق ذلك الوقت ؟ ام انه من الافضل التطبيق للعمليات جميعها على كافة السجلات ليتم بعد ذلك التنقل والاستعراض دون اعادة اجراء العمليات على كل دفعة سجلات ؟؟

حلو جدا دمج فكرة الاستاذ @منتصر الانسي Option Compare Database Option Explicit ' ===== متغير عام لتفعيل الطباعة في نافذة Immediate ===== Public DebugMod As Boolean ' =============================================== ' دالة رئيسية: تقوم بعملية DLookup مع دعم المعايير المتعددة ' =============================================== Public Function GenericDLookup( _ ByVal strFieldName As String, _ ByVal strTableName As String, _ ParamArray arrCriteria() As Variant) As Variant On Error GoTo ErrHandler Dim strCriteria As String Dim lngIndex As Long Dim strField As String, strOperator As String Dim varValue As Variant Dim strOneCondition As String Dim db As DAO.Database: Set db = CurrentDb Dim tdf As DAO.TableDef: Set tdf = db.TableDefs(strTableName) ' التحقق من وجود الجدول والحقل الأساسي If Not TableExists(strTableName, db) Then Err.Raise vbObjectError + 517, , "الجدول غير موجود: " & strTableName If Not FieldExists(strFieldName, tdf) Then Err.Raise vbObjectError + 518, , "الحقل غير موجود: " & strFieldName ' التحقق من شكل المصفوفة If (UBound(arrCriteria) + 1) Mod 3 <> 0 Then Err.Raise vbObjectError + 514, , "المعايير يجب أن تكون ثلاثية" For lngIndex = 0 To UBound(arrCriteria) Step 3 strField = CStr(arrCriteria(lngIndex)) strOperator = Trim(UCase(CStr(arrCriteria(lngIndex + 1)))) varValue = arrCriteria(lngIndex + 2) If Not FieldExists(strField, tdf) Then Err.Raise vbObjectError + 519, , "الحقل غير موجود: " & strField Select Case strOperator Case "IS NULL", "IS NOT NULL" strOneCondition = "[" & strField & "] " & strOperator Case "LIKE", "=", "<>", "<", ">", "<=", ">=" strOneCondition = "[" & strField & "] " & strOperator & " " & cSQLSafe(strTableName, strField, varValue, db, tdf) Case "BETWEEN" If IsArray(varValue) And UBound(varValue) = 1 Then strOneCondition = "[" & strField & "] BETWEEN " & _ cSQLSafe(strTableName, strField, varValue(0), db, tdf) & " AND " & _ cSQLSafe(strTableName, strField, varValue(1), db, tdf) Else Err.Raise vbObjectError + 520, , "القيمة لـ BETWEEN يجب أن تكون مصفوفة من عنصرين" End If Case "IN" If IsArray(varValue) Then Dim i As Long, strIN As String For i = LBound(varValue) To UBound(varValue) strIN = strIN & IIf(Len(strIN) > 0, ", ", "") & cSQLSafe(strTableName, strField, varValue(i), db, tdf) Next strOneCondition = "[" & strField & "] IN (" & strIN & ")" Else strOneCondition = "[" & strField & "] = " & cSQLSafe(strTableName, strField, varValue, db, tdf) End If Case "EXISTS" strOneCondition = "EXISTS (" & varValue & ")" Case Else Err.Raise vbObjectError + 515, , "المعامل غير مدعوم: " & strOperator End Select If Len(strCriteria) > 0 Then strCriteria = strCriteria & " AND " strCriteria = strCriteria & strOneCondition Next If DebugMod Then Debug.Print "GenericDLookup Criteria: " & strCriteria GenericDLookup = DLookup(strFieldName, strTableName, strCriteria) Exit Function ErrHandler: If DebugMod Then Debug.Print "خطأ في GenericDLookup: " & Err.Number & " - " & Err.Description GenericDLookup = Null End Function ' =============================================== ' التحقق من وجود الجدول ' =============================================== Private Function TableExists(TableName As String, db As DAO.Database) As Boolean On Error Resume Next Dim tdf As DAO.TableDef: Set tdf = db.TableDefs(TableName) TableExists = Not tdf Is Nothing On Error GoTo 0 End Function ' =============================================== ' التحقق من وجود الحقل داخل الجدول ' =============================================== Private Function FieldExists(FieldName As String, tdf As DAO.TableDef) As Boolean On Error Resume Next Dim fld As DAO.Field: Set fld = tdf.Fields(FieldName) FieldExists = Not fld Is Nothing On Error GoTo 0 End Function ' =============================================== ' تنسيق القيمة حسب نوع الحقل لاستخدامها داخل SQL ' =============================================== Public Function cSQLSafe(strTable As String, strField As String, varValue As Variant, _ Optional db As DAO.Database = Nothing, Optional tdf As DAO.TableDef = Nothing) As String On Error GoTo HandleError If db Is Nothing Then Set db = CurrentDb If tdf Is Nothing Then Set tdf = db.TableDefs(strTable) Dim fld As DAO.Field: Set fld = tdf.Fields(strField) Dim intType As Integer: intType = fld.Type If IsNull(varValue) Then cSQLSafe = "NULL": Exit Function Select Case intType Case dbText, dbMemo, dbGUID cSQLSafe = "'" & Replace(CStr(varValue), "'", "''") & "'" Case dbDate Dim dtm As Date If TryParseAnyDate(varValue, dtm) Then cSQLSafe = "#" & Format(dtm, IIf(TimeValue(dtm) = 0, "yyyy-mm-dd", "yyyy-mm-dd hh:nn:ss")) & "#" Else cSQLSafe = "NULL" End If Case dbBoolean cSQLSafe = IIf(varValue, "-1", "0") Case dbByte, dbInteger, dbLong, dbSingle, dbDouble, dbCurrency, dbDecimal If IsNumeric(varValue) Then cSQLSafe = Replace(Format(CDbl(varValue), "0.########"), ",", ".") Else cSQLSafe = "NULL" End If Case Else cSQLSafe = "NULL" End Select Exit Function HandleError: If DebugMod Then Debug.Print "[cSQLSafe] خطأ: " & Err.Number & " - " & Err.Description cSQLSafe = "NULL" End Function ' =============================================== ' دالة تحويل أي تنسيق تاريخ إلى قيمة صالحة ' =============================================== Public Function TryParseAnyDate(ByVal strInput As Variant, ByRef dtmOut As Date) As Boolean On Error GoTo Fail If IsNull(strInput) Then GoTo Fail If IsDate(strInput) Then dtmOut = CDate(strInput): TryParseAnyDate = True: Exit Function Dim parts() As String, dd As Integer, mm As Integer, yyyy As Integer Dim timePart As String, strClean As String strClean = Trim(CStr(strInput)) If InStr(strClean, " ") > 0 Then parts = Split(strClean, " ") strClean = parts(0) If UBound(parts) > 0 Then timePart = parts(1) End If strClean = Replace(Replace(strClean, "/", "."), "-", ".") parts = Split(strClean, ".") If UBound(parts) = 2 Then dd = Val(parts(0)): mm = Val(parts(1)): yyyy = Val(parts(2)) If yyyy < 100 Then yyyy = yyyy + IIf(yyyy < 30, 2000, 1900) If mm > 12 Then Dim tmp As Integer tmp = dd dd = mm mm = tmp End If If IsDate(DateSerial(yyyy, mm, dd)) Then dtmOut = DateSerial(yyyy, mm, dd) If Len(timePart) > 0 And IsDate(timePart) Then dtmOut = dtmOut + TimeValue(timePart) TryParseAnyDate = True Exit Function End If End If Fail: TryParseAnyDate = False End Function الاستدعاء Dim varResult As Variant varResult = GenericDLookup("date2", "tbl2", _ "date2", "=", Me.text1, _ "usr_id", "=", Me.text2 _ ) If IsNull(varResult) Then MsgBox "لا توجد نتيجة" Else MsgBox varResult End If

من فضلك ما هو رابط قناة (عماد غازي رحمة ) ؟

ما رأيك بهذه الفكرة أيضاً .. On Error GoTo ErrorHandler Dim folderNames As Variant Dim folderPath As String Dim result As Long Dim i As Long folderNames = Array( _ "DDB_Control", "IMG_Company", "IMG_Company_ReP", "IMG_Wallpaper_backgreound", _ "App_IMG_Wallpaper_backgreound", "IMG_Editor_Menu", "Cantry_IMG", "fonts", _ "Icon_Button", "Icon_Msgbox", "Sound", "Wallpaper", "Video", "db_BE", _ "ExE", "IMG_Report", "File_word", "File_Excel", "Book", "File_PowerPoint", _ "File_Text", "File_Code", "All_InFile_One_Zip_Rar", "ICOn", "Icon_bar_DB", _ "Icon_bar_Form_Report", "Icon_Button", "icon_Gif", "Icon_Msgbox", _ "LinkedDB_Backups", "Office_Video", "Qr", "QR_User", "Resources", _ "World_Cantry", "Gif_IMG", "Fix_Photo", "db_db_db_test_link", _ "Corrupted_DBs", "Corrupted_Archives", "Change_Dy_Time_All_Table", _ "Add Fonts.bmp" _ ) For i = LBound(folderNames) To UBound(folderNames) folderPath = Application.CurrentProject.Path & "\" & folderNames(i) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً! " & folderPath Me.lblStatus.ForeColor = vbRed End If DoEvents Next i Exit Sub ErrorHandler: Me.lblStatus.Caption = "حدث خطأ: " & Err.Description Me.lblStatus.ForeColor = vbRed

الاستاذة @منتصر الانسي و @hanan_ms تم عمل موضوع خاص لمشاركاتكم

بالعكس ، فانت تقوم بجعل البرنامج بطئ بدون سبب !! بما ان الاكسس يقوم بما عليه وبكل اريحية ، فلماذا تغير الوضع ؟ نعم تستطيع عمل هذا بالكود ، بتحميل بيانات الاستعلام التي تم معالجتها دفعة واحدة ، ولكنك ستدفع ثمن التأخير : dim rst as dao.recordset set rst=currentdb.openrecordset("Select * From Query1") rst.movelast rst.movefirst او في النموذج المستمر ، عند تحميل النموذج: docmd.gotorecord,,aclast docmd.gotorecord,,acfirst

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

اذا السؤال الان هل لو الاستعلام معقد ويعالج العديد من البيانات اذا تتم المعالجة مع كل دفعة اذا الافضل مع هذه الحالات محاولة التحايل بطريقة ما لتحميل البيانات دفعة واحدة لتطبيق كافة العمليات

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

أ / محمد صالح و أ/ حجازي حلول في منتهى الروعة والابداع وفقكم الله ونفع بعلمكم مشاركة أ/ حجازي فنانة ومحترفة ولكن سأختار مشاركة أ / محمد صالح لأنني سأستخدمها مع وافر الشكر وعظيم الامتنان للجميع

جزاكم الله خيـــــــــرا استاذى والان تعلمت شئ جديد وتم تصحيح معلومة مغلوطة لدى

انت تأكد كلامي ولكن بعدد سجلات مختلف (قد يعتمد على العدد الذي تم عرضه) ، فلو ان الاكسس "كان يعالج باقي السجلات تدريجيا فقط في الخلفية" ، لحصلت على العدد 100 ، وهو عدد سجلات الكامل في الجدول.

النسخة اللي عندي 2019 انجليزية = 64 بت

الصراحة أن هذه المشكلة مثل المخدر الذي لا يستطيع الشخص الإقلاع عنا إلا بحلها وكلما قلت سأقلع عن التفكير فيها أرجع لها وبقوة توصلت أخيرا لدالة تحويل تشية دوال التحويل المضمنة (CStr أو CDbl أو CDate) ولكنها بإسم CSql تقوم بتحويل جميع أنواع البيانات لتلائم أوامر Sql وللمفاجأة نجحت في العمل كل الذي سويته أني عدلت [date1] الى cSql([dat1]) وأزلت علامتي # لأن الدالة ستقوم بهذا العمل (لم أقم بتطبيقها مع حقل [user_id] لأنها تعرفت عليه كرقم وبالتالي لم تضيف علامة التنصيص له فأبقيت الحال على ماهو عليه) وبالفعل كانت النتيجة كما هو متوقع والسبب في ذلك في إعتقادي أن الدالة قامت بمراعاة الإعدادات الإقليمية عند قراءة التاريخ فالتاريخ #03/06/2025# في بلدات تعني اليوم الثالث من الشهر السادس وفي بلدان اخرى تعني اليوم السادس من الشهر الثالث وهذا هو سبب الإلتباس المنطقي للمشكلة في إعتقادي عموما ارفقت الملف الأصلي بعد تطبيق هذه الدالة ليكون حل من ضمن الحلول الذي قام بها بقية الأساتذة مع تحياتي d8.rar

طيب ، جرب هذا الحل الذي لا يعتمد على اي تقرير أو جدول , حيث سيتم قراءة الصور من المجلد A1 ، ثم دمجها إلى ملف PDF داخل المجلد PDF . لم أضف فكرة حذف الصور بعد الدمج حتى تتأكد من أن هذا طلبك 100% Arshafah.zip

مع التجربة عندما افتح الاستعلام واغلقه سريعا فقط يكون العدد 37 سجل فى الجدول الجديد ولو فتحت الاستعلام وانتظرت ثوان اكثر من ذى قبل يكون 64 تقريبا هذا يعني أن الاكسس كان يعالج باقي السجلات تدريجيا فقط في الخلفية رغم أنه تم فتح الاستعلام فقط ولم احاول استعراض اى عدد من السجلات

ممنون من حضرتك استاذي الفاضل : استاذي الفاضل ان الحل الاول ممتاز 100% ولكن مشكلته انه يجلب الصورة الى التقرير بناءا على رابط الصورة الموجود في الجدول وهنا ان الصور بلا روابط فقط رابط المجلد الذي يحتويها في الاخير انا اريد تحويل الصور ودمجه في ملف ةاحد pdf سواءا عبر التقرير او غيره بالنسبة لتغيير الرابط ممكن تركه لمرحلة اخرى سوف اطرح بها مشاركة جديدة مع وافر التحايا

أمر محير حقا ممن المشكل في لغة نسخة الأوفيس فأنا عندي نسخة 2016 عربية

تفضل يا سيدي يعرض نتائج السجلات على الشاشة فقط

بعد اذن استاذى الجليل و معلمى القدير تجربة عملية: أضف Debug.Print ID داخل دالة Add_One افتح الاستعلام ولا تعرض سجلات اخرى افتح محرر الاكواد وانظر الى النتيجة تجد انه تم معالجة كل البيانات دفعة واحده تجربة عملية رقم (2) اعتذر عندى مشكلة لا استطيع اضافة اى مرفقات من فضلك قك بانشاء جدولا من خلال الاستعلام التالى CREATE TABLE tblFunctionCalls ( ID AUTOINCREMENT PRIMARY KEY, FunctionName TEXT(50), CallTime DATETIME, Param1 DOUBLE, Param2 DOUBLE, ResultValue DOUBLE, ContextInfo TEXT(100) ); انظر الى الكود التالى بتعديل بسيط Public Function Add_One(lngID As Long, dblN As Double) As Double Dim dblResult As Double dblResult = dblN + 1.5 If lngID = 55 Then dblResult = 55 End If ' تسجيل الاستدعاء في الجدول On Error Resume Next CurrentDb.Execute "INSERT INTO tblFunctionCalls (FunctionName, CallTime, Param1, Param2, ResultValue, ContextInfo) " & _ "VALUES ('Add_One', Now(), " & lngID & ", " & dblN & ", " & dblResult & ", '" & Nz(Application.CurrentObjectName, "Unknown") & "')" On Error GoTo 0 Add_One = dblResult End Function الان قم بفتح الاستعلام ولا تحرك الشاشة ولا تعرض اى سجلات اغلق الاستعلام انظر الى الجدول

طيب تمام ، الآن اللي وضح لي كالآتي :- 1. من خلال الزر ، تريد ان يتم دمج الصورة الى المجلد PDF بملف بصيغة PDF بحيث كل صورة في صفحة . 2. بعد التصدير ونجاح العملية ، حذف الصور وتفريغ المجلد A1 من محتوياته . لكن الغير واضح هو :- أرجو منك التوضيح بشكل يسير أخي الفاضل !!