كود سكنر بصيغة PDF لعدة اوراق

[nogom]

السلام عليكم

اريد كود يقوم بسحب الاوراق بصيغة PDF مع تسمية الملف من الحقل المسجل في الاكسس مع تحديد مكان الحفظ او الحفظ تلقائي في مجلد معين

 

[gavan]

والله سوال جميل جدا , ولكن يحتاج الى جواب مفصل و يحتوي كل سطر الى شرح وانا كذلك انتظر الجواب

, تحياتي

[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

ما يجب عليك فعله:

1. قم بتنزيل وتثبيت PDFtk Server. فهو مجاني
2. أضف مسار PDFtk إلى الكود أو إلى متغيرات النظام. كما هو موضح بالكود
3. اختبر الكود وتأكد من أن الصور يتم دمجها بنجاح إلى PDF. 

[kkhalifa1960]

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

pdftk.rar

[gavan]

ربي يبارك في عمرك وعملك يارب العالمين 

شكرا جزيلا جدا على الشرح الوافي