كل الانشطه

بعد اذن استاذى الجليل و معلمى القدير تجربة عملية: أضف Debug.Print ID داخل دالة Add_One افتح الاستعلام ولا تعرض سجلات اخرى افتح محرر الاكواد وانظر الى النتيجة تجد انه تم معالجة كل البيانات دفعة واحده

طيب تمام ، الآن اللي وضح لي كالآتي :- 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

كل التقدير والاحترام لحظرتك اخي الكريم (منتصر الانسي) هذا بالضيط المطلوب وفقك الله ودمت بالف خير

تحية طيبة أخي @Foksh القاعدة الأصلية التي أعمل عليها مشابهة لهذه تقريبا فقط اختصرت بعض الحقول - المبدأ العام هكذا فقط قمت بتغيير : حجم الحقل - التنسيق - المنازل العشرية * كما في الصورة المرفقة 1 * ليصبح بنفس ما هو ما جود في القاعدة الأصلية * المشكل مزال يظهر كما في الصورة المرفقة 2 لو سمحت أرفقت القاعدة المعدلة للتجريب عليها(للمرة الأخيرة حتى لا أثقل عليك أشغلك كثيرا فقط بهذا الموضوع ) وإن اشتغلت عندك فالمشكل على مستواي فجزاك الله كل الخير أخي ,استاذنا @Foksh -آميـــــــن كما أتوجه بالشكر والإمتنان لمعلمنا الجليل @ابوخليل جزاه الله كل الخير - آميــــــن baseM10.accdb

حل رائع للاستاذ/ محمد إليك حل آخر بالأكواد مع اظهار الكلمات المكررة وعددها الاقتباس 2.xlsm

يمكنك تجربة هذه المعادلة =SUMPRODUCT(--ISNUMBER(SEARCH(" " & TRIM(MID(SUBSTITUTE(A2," ",REPT(" ",100)), (ROW(INDIRECT("1:" & LEN(A2)-LEN(SUBSTITUTE(A2," ",""))+1))-1)*100+1, 100)) & " ", " " & $D$2 & " "))) بالتوفيق

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

نفضل المثال بعد التعديل مثال.rar

استاذي الفاضل Foksh ربي يحفظك يا طيب ممنون من حضرتك جزاك الله خيرا الله يسلمك ويحفظك يارب

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

أعتقد أني لم أستوعب الفكرة تماما أو أكون قد فهمت منها ماجعلني أستصعبها صراحة 😅 - هل ستكون قاعدة البيانات هذه فارغة تماما أم ستحتوي على أكواد ستقوم بفتح التطبيق الخاص بنا؟ - هل الإختصار سيكون لقاعدة البيانات الفارغة أم للمجلد ؟ - أكثر عبارة لم أفهمها هي (اضافة ملفات برقة بيضاء شكلا ووهم ان هذه هي القاعدة) فياريت لو توضحي الفكرة بمثال عملي أو فيديو مثل كل مرة مع تحياتي

وتوضيحا فقط وحسب فهمى لقول استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ جعفر - الاكسس يعالج فقط السجلات المعروضة على الشاشة (مثلا 30)؟ صحيح فقط في حالة النماذج (Forms) وغير صحيح في حالة فتح الاستعلام مباشرة أو في التقارير أو التصدير الاكسس ينفذ الاستعلام بالكامل ويحسب النتائج لكل السجلات - إذا كان الاستعلام مصدرا لنموذج فلن يكون هناك بطء ملحوظ؟ صحيح إذا لم تستخدم دوال خارجية في حقول يتم عليها فرز/تصفية لو كان هناك: فرز أو تصفية على حقل فيه دالة DLookup أو دالة VBA خارجية أو تحميل بيانات من جدول كبير بدون فهرسة مناسبة - الطباعة لا تسبب بطء لأنها تطبع صفحة صفحة؟ غير دقيق: الاكسس يقوم بتجهيز التقرير بالكامل قبل عرض أول صفحة أي دوال خارجية أو معادلات تحسب على كل السجلات قبل العرض والطباعة - لا يوجد بطء عند استخدام دوال خارجية إذا لم تكن هناك عمليات فرز أو تصفية؟ صحيح تماما في حالة: استخدام الاستعلام كمصدر نموذج أو عرض النتائج فقط دون فرز/تصفية على الحقول التي تنادي دوال خارجية لكن عند فتح الاستعلام مباشرة أو فرز/تصفية الحقول المحسوبة الاكسس يجبر على حساب القيم لكل السجلات ردودى السابقة لتحليل فهمى لمشاركة الاستاذ جعفر حسب فهمى ومعلوماتى الشخصية وان كان فهمى خاطى أنتظر التصحيح من اساتذتى العظماء

تمازحني بلا شك معلمي الفاضل 😅 .. هذه محاولة قديمة تتعامل مع الأمر نفسه بدون جدول أو تقرير من خلال Word . ولكني لم أدرجها خشية أن يقول لي أحد أنه ماذا لو لم يكن هناك برنامج Word . Dim fd As Object Dim selectedFile As Variant Dim pdfPath As String Dim wordApp As Object Dim wordDoc As Object Dim imgPath As String Dim imgCount As Integer Dim firstImage As Boolean Set fd = Application.FileDialog(3) With fd .Title = "اختر الصور المطلوبة" .AllowMultiSelect = True .Filters.Clear .Filters.Add "ملفات الصور", "*.jpg;*.jpeg;*.png;*.bmp;*.gif" If .Show = -1 Then pdfPath = CurrentProject.Path & "\A2\الصور_المحددة_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".pdf" If Dir(CurrentProject.Path & "\A2", vbDirectory) = "" Then MkDir CurrentProject.Path & "\A2" End If Set wordApp = CreateObject("Word.Application") Set wordDoc = wordApp.Documents.Add wordApp.Visible = False With wordDoc.PageSetup .Orientation = 0 .TopMargin = 36 .BottomMargin = 36 .LeftMargin = 36 .RightMargin = 36 End With imgCount = 0 firstImage = True For Each selectedFile In .SelectedItems imgPath = CStr(selectedFile) imgCount = imgCount + 1 With wordDoc.Content If Not firstImage Then .InsertBreak 2 ' فاصل صفحة قبل الصورة الجديدة (ماعدا الأولى) Else firstImage = False End If .InsertAfter vbCrLf .ParagraphFormat.Alignment = 1 .InlineShapes.AddPicture imgPath, False, True End With With wordDoc.InlineShapes(wordDoc.InlineShapes.Count) .LockAspectRatio = True If .Width > 500 Then .Width = 500 End With Next selectedFile wordDoc.Range(0, 0).Delete wordDoc.SaveAs2 pdfPath, 17 wordDoc.Close False wordApp.Quit MsgBox "بنجاح إلى المسار PDF تم تصدير الصور لملف " & vbCrLf & _ pdfPath, _ vbInformation + vbMsgBoxRight, "" Else MsgBox "لم يتم اختيار أي صور", vbExclamation + vbMsgBoxRight, "" End If End With Set wordDoc = Nothing Set wordApp = Nothing Set fd = Nothing وتم توضيح بعض الأجزاء بتعليقات بسيطة ..

السلام عليكم ورحمة الله وبركاته اخوتي الكرام المطلوب - انشاء استعلام يظهر فيه الاسم الكامل و اعلى (احدث) تاريخ للامر مع رقم الامر . للقاعده المرفقه طيا . مع الشكر والتقدير مقدما مثال.accdb

الاكسس يقوم بحساب السجلات المعروضة على الشاشة فقط عندما يكون ذلك داخل نموذج وليس داخل استعلام هذا حسب فهمى المتواضع قد اكون مخطئ. ربما هذا الظاهر فقط الان ولكن انا دائما مع الاستعلامات اعمل وفق هذه القاعدة الذهبية دائما الأولوية للمنطق المباشر أفضل من الاعتماد على الحيل النصية عند فتح استعلام مباشرة (Query View أو من الكود) Access يقوم بتحميل كل السجلات دفعة واحدة وليس فقط الظاهرة على الشاشة يعني: سواء كان عندك 100 أو 1000,000 سجل وسواء كان حجم الشاشة يعرض 30 فقط او حتى 10 بمجرد فتح الاستعلام مباشرة (من نافذة Access أو من الكود) يقوم Access بتنفيذ الاستعلام بالكامل من البداية إلى النهاية ويحسب ويقوم بمعالجة البيانات فى كل الأعمدة بما فيها الدوال مثل DLookup أو أي دوال خارجية ثم يظهر أول 30 سجل فقط او اول 10 سجلات حسب حجم الشاشة لكن المعالجة تمت لكل السجلات بالفعل

حبيبنا @ابو جودي اقرأ تعليق الأستاذ جعفر هنا 🙂 : وحسب ما يظهر أن الاستعلام هنا لا يتعدى السبع سجلات ، وهي بعدد أيام الأسبوع.

تفضل أخي الكريم ، ما تم هو:- انشاء جدول يحتوي حقل ترقيم تلقائي ( ليس ذا علاقة بالموضوع ، ولكنه عادة ... ) ، وحقل لإضافة المسارات اليه عند اختيارك للصور . ثم إنشاء تقرير مصدره الجدول السابق ، وتم إنشاء عنصر صورة مصدره المربع النصي المرتبط بالحقل الخاص بالمسارات . ثم داخل التقرير لعرض كل صورة في صفحة مستقلة ، في قسم التفاصيل = = تقسيم الصفحات بعد هذا الجزء . وفي نموذج الإفتراضي ، في الزر جعلت لك الأحداث داخل نفس الزر بحيث عند النقر عليه ، تستطيع اختيار الصور التي تريدها ، وبعد الموافقة عليها سيتم فتح التقرير وتصديره الى ملف PDF في المجلد A2 كما طلبت . وهذا من خلال الكود التالي :- Private Sub Command0_Click() Dim fd As Object, selectedFile, db As DAO.Database, rs As DAO.Recordset Dim response As Integer, exportPath As String response = MsgBox("هل تريد حذف السجلات القديمة قبل إضافة الصور الجديدة؟" & vbCrLf & vbCrLf & _ "نعم: لحذف السجلات القديمة أولاً" & vbCrLf & _ "لا: للإبقاء على السجلات القديمة وإضافة الجديدة" & vbCrLf & _ "إلغاء: لإيقاف العملية بالكامل", _ vbQuestion + vbYesNoCancel + vbMsgBoxRight, "خيارات الإضافة") If response = vbCancel Then Exit Sub exportPath = CurrentProject.Path & "\A2\تقرير_الصور_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".pdf" If Dir(CurrentProject.Path & "\A2", vbDirectory) = "" Then MkDir CurrentProject.Path & "\A2" Set db = CurrentDb() If response = vbYes Then db.Execute "DELETE FROM Tbl_Foksh", dbFailOnError Set fd = Application.FileDialog(3) With fd .Title = "اختر الصور المطلوبة" .AllowMultiSelect = True .Filters.Clear .Filters.Add "ملفات الصور", "*.jpg;*.jpeg;*.png;*.bmp;*.gif" If .Show = -1 Then Set rs = db.OpenRecordset("Tbl_Foksh") For Each selectedFile In .SelectedItems rs.AddNew rs!Pic_Path = CStr(selectedFile) rs.Update Next rs.Close DoCmd.OutputTo acOutputReport, "Report1", acFormatPDF, exportPath, False MsgBox "تمت العملية بنجاح" & vbCrLf & _ IIf(response = vbYes, "تم حذف السجلات القديمة", "تم الاحتفاظ بالسجلات القديمة") & vbCrLf & _ "تم إضافة مسارات الصور الجديدة" & vbCrLf & _ "تم تصدير التقرير إلى: " & exportPath, _ vbInformation + vbMsgBoxRight, "" Else MsgBox "لم يتم اختيار أي ملفات", vbExclamation + vbMsgBoxRight, "" End If End With Set rs = Nothing: Set db = Nothing: Set fd = Nothing End Sub حيث يسمح لك الكود ، بحذف السجلات السابقة من الجدول أو الإحتفاظ بها وإضافة صور ( سجلات جديدة ) أو إلغاء العملية كاملة . ملف للتجربة :- frmPDF.zip