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

مرفق لكم ملف يحتوى على ثلاث نماذج f1,f2,f3 قم بفتح f1 ستجد مسطرة افقيه ومسطرة رأسية يقومان بالتحرك داخل نموذج f1 تقديرا وعرفانا لهذا المنتدى الكبير Database16.accdb يرجى عند التحريك الضغط على زر الامر scroll والتحرك

وعليكم السلام و رحمة الله و بركاته ا ولكن طلبت تحويل من العربي الى انجليزية، هل هاذا ما تريده ام عكس من انجليزي الى العربي وثانيا هل تريد تنفيذ الكود في حدث بعد تحديث TextBox2 ولا عند ضغط على زر أمر حفظ

@ابوخليل @ابو جودي @Moosak @AbuuAhmed @Foksh @kkhalifa1960 وجميع من له اهتمام بهذا الموضوع.. الرجاء التصويت على اقتراح الأستاذ @محمد طاهر عرفه

جزاك الله خيرا نعم هذا ما اقصد تماما الف الف شكر لك استادي Foksh

وعليكم السلام ورحمة الله وبركاته .. اخي العزيز من باب التوضيح ، هل الفترة التي تقصد بها في مثالك = التاريخ ؟؟؟؟؟؟؟ اذا كان جوابك نعم ، فإليك المرفق بعد التعديل باضافة طريقتين ، الأولى استعلام من خلال كود VBA والثانية استعلام SQL SKL.accdb

ياربي يسلمك من كل مكروه، ربي يبارك فيك يارب، وباربي اغفر له وارحمه واسكنه فسيح جناتك يارب، قطعة فنية من المبدع، سلمت يداك جاري التجربة 🌹👍♥️

وهذه هي الاداة () يمكنك فك الضغط عنها وتثبيتها . pdftk.rar

وعليكم السلام اعمل هكذا Private Sub cbo1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) on error resume next Me.cbo1.Dropdown End Sub

المفروض ان تضع عينة للنتائج المتوقعة على ورقة العميل للتأكد من الخلايا المرحلة والأعمدة المرحل اليها حاول تعديل الكود التالي بما يناسبك Sub test() Dim srcWS As Worksheet, dest As Worksheet Dim f As String, Lr As Long Dim a(1 To 1, 1 To 3) As Variant Set srcWS = Sheets("تسجيل") f = srcWS.Range("C8").Value On Error Resume Next Set dest = ThisWorkbook.Sheets(f) On Error GoTo 0 If dest Is Nothing Then: MsgBox "ورقة العميل '" & f & "' غير موجودة", vbExclamation: Exit Sub If srcWS.Range("C7").Value = "اجل" Then a(1, 1) = Format(Date, "dd/mm/yyyy") ' التاريخ a(1, 2) = srcWS.[C4].Value & " " & srcWS.[C5].Value 'الوصف مع الكود a(1, 3) = srcWS.[C6].Value 'سعر البيع Lr = dest.Cells(dest.Rows.Count, "B").End(xlUp).Row + 1 dest.Range(dest.Cells(Lr, "B"), dest.Cells(Lr, "D")).Value = a MsgBox "تم الترحيل بنجاح إلى ورقة العميل " & f, vbInformation End If End Sub

وعليكم السلام ورحمة الله.. نعم.. أوافق..

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

أخونا الكريم @zero1111330566 ، وجب عليك ان تنسب أفضل إجابة للأستاذ @kkhalifa1960 صاحب الإجابة التي ناسبتك وحلت لك المشكلة ، وليس لك يا صديقي

تفضل استاذ @nogom .الخطوات . لأني ماعندي سكانر . افتح محرر VBA، ثم اذهب إلى: Tools > References واختر Microsoft Windows Image Acquisition Library. يتم مسح المستندات ضوئيًا باستخدام مكتبة WIA. يتم حفظ الصور في مجلد مؤقت. يتم دمج الصور إلى ملف PDF باستخدام PDFtk. يتم حفظ مسار الملف النهائي في قاعدة بيانات Access. Option Compare Database Option Explicit Sub ScanAndSavePDF() Dim scanner As WIA.Device Dim dialog As New WIA.CommonDialog Dim item As WIA.Item Dim img As WIA.ImageFile Dim imagesFolder As String Dim pdfPath As String Dim db As DAO.Database Dim rs As DAO.Recordset Dim fileName As String Dim recordID As String Dim tempPath As String Dim i As Integer Dim imageFiles As String Dim command As String ' تحديد مسار حفظ الصور والملف PDF imagesFolder = "C:\ScannedImages\" ' قم بتعديل المسار حسب الحاجة If Dir(imagesFolder, vbDirectory) = "" Then MkDir imagesFolder tempPath = imagesFolder & "Temp\" If Dir(tempPath, vbDirectory) = "" Then MkDir tempPath ' اختيار الماسح الضوئي On Error Resume Next Set scanner = dialog.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False) If scanner Is Nothing Then MsgBox "لم يتم اختيار ماسح ضوئي.", vbExclamation Exit Sub End If On Error GoTo 0 ' جلب السجلات من الجدول Set db = CurrentDb Set rs = db.OpenRecordset("اسم_الجدول") ' ضع اسم الجدول هنا If rs.EOF Then MsgBox "لا توجد سجلات في الجدول.", vbExclamation Exit Sub End If Do While Not rs.EOF recordID = rs!اسم_الحقل ' ضع اسم الحقل الذي يحتوي على اسم الملف ' مسح الأوراق imageFiles = "" For i = 1 To 5 ' مسح 5 صفحات، يمكن تعديل العدد حسب الحاجة Set item = scanner.Items(1) Set img = dialog.ShowTransfer(item, WIA.FormatID.wiaFormatJPEG) ' حفظ الصورة fileName = tempPath & "Page_" & i & ".jpg" img.SaveFile fileName imageFiles = imageFiles & Chr(34) & fileName & Chr(34) & " " Next i ' إنشاء ملف PDF باستخدام PDFtk pdfPath = imagesFolder & recordID & ".pdf" command = Chr(34) & "C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe" & Chr(34) & _ " " & imageFiles & " cat output " & Chr(34) & pdfPath & Chr(34) , C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe ,حسب مكانه عندك Shell command, vbHide ' حفظ المسار في الجدول rs.Edit rs!مسار_الملف = pdfPath ' ضع اسم الحقل الخاص بالمسار rs.Update ' تنظيف الصور المؤقتة Dim tempFile As String tempFile = Dir(tempPath & "*.jpg") Do While tempFile <> "" Kill tempPath & tempFile tempFile = Dir Loop rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم مسح الملفات وحفظها بنجاح.", vbInformation End Sub ما يجب عليك فعله: قم بتنزيل وتثبيت PDFtk Server. فهو مجاني أضف مسار PDFtk إلى الكود أو إلى متغيرات النظام. كما هو موضح بالكود اختبر الكود وتأكد من أن الصور يتم دمجها بنجاح إلى PDF.

شكرا جزيلا بارك الله في حضرتك.... خالص الاحنترام و التقدير