كل الانشطه

ما رأيك بهذه الفكرة أيضاً .. 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 من محتوياته . لكن الغير واضح هو :- أرجو منك التوضيح بشكل يسير أخي الفاضل !!

السلام عليكم انا فخور أن مشاركاتي الطويلة يتم قراءتها ويُستفاد منها 🙂 انا دائما انظر لعملي ، انه بعد 3 اشهر او اكثر ، يرجع لي المستخدم بطلب تعديل ، وانا اكون نسيت تفاصيل برنامجي. لهذا السبب ، فلا آخذ بطريق اخوي موسى ولا ابو جودي (معلش ، محدش يزعل ) ، وانما اعمل دالة خارجية واعمل بها عدد الاسطر اللي احب من الكود ، واكتب تعليق واضح على كل سطر ، لأني لما اريد اعمل تعديل ، بكل بساطة اعرف المكان اللي اريد اعدل عليه ، ولحظات واكمل التعديل ، اما لتعديل اي شيء في معادلات اخوي ابو جودي وموسى ، فأنا مضطر احك راسي الى ان افهم شو اللي كنت عامله سابقا ، ثم افكر في مكان التعديل. ولما تستخدم دالة خارجية ، استخدم ElseIf او Case قدر الامكان ، ومع انه قد يكون عندك 100 سطر كود (مثلا) ، إلا انك في الواقع تستعمل بضع اسطر فقط ، وتكون الدالة سريعة. الدليل خير برهان 🙂 اخوي موسى فهم كلامي بالطريقة الصحيحة 🙂 ارفق مثال بسيط لأثبت قولي: عندنا جدولين . واستعلام فيه الامر Dlookup ، وانادي الدالة Add_One . الدالة Add_One Function Add_One(ID As Long, N As Long) As Double Add_One = N + 1.5 If ID = 55 Then Add_One = 55 End If End Function . الان نريد ان نثبت ان الاستعلام . سأقوم بتوقيف الاستعلام عندما يعرض على الشاشة السجل Auto_ID=55 ، وهذا معناه انه اذا ظهر السجل على الشاشة ، فسيقوم الاستعلام في الاكسس بحساب قيمته ، اما السجل الذي لم يظهر على الشاشة ، فالاكسس لا يقوم بحساب قيمته . وهنا قمت بتشغيل الاستعلام ، واظهرت 27 سجل فقط ، ثم 27 سجل آخر 27+27=54 ، ثم طلبت عرض السجل Auto_ID=55 ، فلم يعطني الاكسس الجواب ، لأنه كان بحاجة الى تمرير البيانات الى الدالة للحصول على نتيجة الدالة ، وهنا توقف الكود. . 1637.Query_Records.accdb

حياك الله استاذي الفاضل Foksh ربي يخليك يارب نعم اريد ان يتغير الرابط بدلا من المجلد A1 يتغير الى مجلد ال PDF وملف ال PDF المدمج يعني دمجها في ملف PDF في مجلد PDF وتغير الرابط في الجدول حسب الحفظ الاخير ثم حذف الصور من المجلد A1

يعني باختصار لما تفضلت به أعلاه :- تريد ان يتم دمج الصور التي في المجلد A1 بغض النظر عن عددها أو طبيعتها أو تكراراتها ، في ملف PDF داخل المجلد A2 !!!!!؟ وإذا كان غير صحيح ما فهمته ، ارجو منك التوضيح بشكل أكثر دقة . وتحديد وظيفة الجدول tblAttach ؟؟؟؟؟

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

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

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

انا عجبتنى الافكار بس اضفت بعض البهارات للطبخة اتمنى لكم مذاقا هنيئا Option Compare Database Option Explicit Public DebugMode As Boolean Public Sub ExportImagesToPdf( _ Optional blnShowImageNames As Boolean = True, _ Optional blnAddPageNumbers As Boolean = True, _ Optional strPdfName As String = "", _ Optional strFolderSource As String = "", _ Optional strFolderTarget As String = "" _ ) Dim strPdfPath As String Dim objFSO As Object, objFolder As Object, objFile As Object Dim objWordApp As Object, objDoc As Object, objRange As Object, objImg As Object Dim colFiles As Collection, arrFiles() As String Dim lngImgCount As Long, i As Long Dim fd As Object On Error GoTo ErrHandler ' اختيار مجلد الصور إذا لم يُمرر If Trim(strFolderSource) = "" Then Set fd = Application.FileDialog(4) With fd .Title = "اختر المجلد الذي يحتوي على الصور" If .Show <> -1 Then If DebugMode Then Debug.Print "تم إلغاء اختيار مجلد الصور." Exit Sub End If strFolderSource = .SelectedItems(1) End With End If If Right(strFolderSource, 1) <> "\" Then strFolderSource = strFolderSource & "\" If DebugMode Then Debug.Print "مجلد الصور: " & strFolderSource ' التحقق من وجود مجلد الصور If Dir(strFolderSource, vbDirectory) = "" Then MsgBox "مجلد الصور غير موجود", vbCritical + vbMsgBoxRight Exit Sub End If ' اختيار مجلد الهدف إذا لم يُمرر If Trim(strFolderTarget) = "" Then Set fd = Application.FileDialog(4) With fd .Title = "اختر المجلد لحفظ ملف PDF" If .Show <> -1 Then If DebugMode Then Debug.Print "تم إلغاء اختيار مجلد الهدف." Exit Sub End If strFolderTarget = .SelectedItems(1) End With End If If Right(strFolderTarget, 1) <> "\" Then strFolderTarget = strFolderTarget & "\" If Dir(strFolderTarget, vbDirectory) = "" Then MkDir strFolderTarget If DebugMode Then Debug.Print "تم إنشاء مجلد الهدف: " & strFolderTarget End If ' إعداد اسم ملف PDF If Trim(strPdfName) = "" Then strPdfPath = strFolderTarget & "صور_المجلد_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".pdf" Else strPdfPath = strFolderTarget & strPdfName & ".pdf" End If If DebugMode Then Debug.Print "مسار ملف PDF: " & strPdfPath ' جمع الصور Set colFiles = New Collection Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strFolderSource) For Each objFile In objFolder.Files If LCase(objFile.Name) Like "*.jpg" Or LCase(objFile.Name) Like "*.jpeg" Or _ LCase(objFile.Name) Like "*.png" Or LCase(objFile.Name) Like "*.bmp" Or _ LCase(objFile.Name) Like "*.gif" Then colFiles.Add objFile.Path lngImgCount = lngImgCount + 1 If DebugMode Then Debug.Print "تم العثور على صورة: " & objFile.Path End If Next If lngImgCount = 0 Then MsgBox "لا توجد صور في المجلد المحدد", vbExclamation + vbMsgBoxRight GoTo CleanExit End If ' تحويل الـ Collection إلى مصفوفة ReDim arrFiles(0 To lngImgCount - 1) For i = 1 To colFiles.Count arrFiles(i - 1) = colFiles(i) Next ' فرز الصور Call SortArray(arrFiles) If DebugMode Then Debug.Print "تم فرز الصور" ' إنشاء مستند Word Set objWordApp = CreateObject("Word.Application") Set objDoc = objWordApp.Documents.Add objWordApp.Visible = False With objDoc.PageSetup .Orientation = 0 .TopMargin = 28 .BottomMargin = 28 .LeftMargin = 28 .RightMargin = 28 End With ' إضافة ترقيم الصفحات (إذا تم اختياره) If blnAddPageNumbers Then With objDoc.Sections(1).Footers(1).PageNumbers .Add 1, True .NumberStyle = 0 ' wdNumberStyleArabic With .Parent.Range .ParagraphFormat.Alignment = 1 ' توسيط .Font.Size = 8 .Font.Color = RGB(100, 100, 100) End With End With End If ' إدراج الصور For i = 0 To UBound(arrFiles) Set objRange = objDoc.Range objRange.Collapse 0 If i > 0 Then objRange.InsertBreak 2 objRange.Collapse 0 End If ' إدراج الصورة objRange.ParagraphFormat.Alignment = 1 Set objImg = objRange.InlineShapes.AddPicture(arrFiles(i), False, True) With objImg .LockAspectRatio = True If .Width > 500 Or .Height > 650 Then If .Width / .Height > 500 / 650 Then .Width = 500 Else .Height = 650 End If End If End With ' إضافة اسم الملف أسفل الصورة (إذا تم اختياره) If blnShowImageNames Then Set objRange = objDoc.Range objRange.Collapse 0 objRange.InsertAfter vbCrLf & Mid(arrFiles(i), InStrRev(arrFiles(i), "\") + 1) With objRange .ParagraphFormat.Alignment = 1 .ParagraphFormat.SpaceAfter = 6 .Font.Size = 9 .Font.Color = RGB(120, 120, 120) End With End If If DebugMode Then Debug.Print "تم إدراج الصورة: " & arrFiles(i) Next ' حذف أي فقرات فارغة في بداية المستند While objDoc.Paragraphs.Count > 0 And Trim(objDoc.Paragraphs(1).Range.Text) = "" objDoc.Paragraphs(1).Range.Delete Wend ' حذف فقرة فارغة محتملة في النهاية If objDoc.Paragraphs.Count > 0 Then With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range If Trim(.Text) = "" Then .Delete End With End If ' حفظ كـ PDF objDoc.SaveAs2 strPdfPath, 17 objDoc.Close False objWordApp.Quit MsgBox "تم إنشاء ملف PDF بنجاح:" & vbCrLf & strPdfPath, vbInformation + vbMsgBoxRight CleanExit: Set objDoc = Nothing Set objWordApp = Nothing Set objRange = Nothing Set objImg = Nothing Set colFiles = Nothing Set objFolder = Nothing Set objFSO = Nothing Set fd = Nothing Exit Sub ErrHandler: If DebugMode Then Debug.Print "خطأ: " & Err.Number & " - " & Err.Description End If MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight Resume CleanExit End Sub Private Sub SortArray(ByRef arr() As String) Dim i As Long, j As Long Dim temp As String For i = LBound(arr) To UBound(arr) - 1 For j = i + 1 To UBound(arr) If UCase(arr(i)) > UCase(arr(j)) Then temp = arr(i) arr(i) = arr(j) arr(j) = temp End If Next j Next i End Sub