استخراج التقرير الى pdf فى مجلد البرنامج

[The best]

من نموذج homescreen عند اختيار التقرير اريد استخراجه بالاسم الموجود فى مربع النص  الى pdf فى مجلد البرنامج وليكن البرنامج موجود فى E 

برنامج الحوافز.rar

[Foksh]

1 ساعه مضت, The best said:

من نموذج homescreen عند اختيار التقرير اريد استخراجه بالاسم الموجود فى مربع النص  الى pdf فى مجلد البرنامج وليكن البرنامج موجود فى E 

برنامج الحوافز.rar 172.57 kB · 0 downloads

وعليكم السلام ورحمة الله وبركاته ,,

 

في مديول عام ، الصق هذا الكود :-

Option Compare Database
Option Explicit

Public pdfPathGlobal As String
Public rptNameGlobal As String

Public Sub ExportReportToPDF(rptName As String, fileName As String)
    On Error Resume Next
    Dim dialog As FileDialog
    Dim pdfPath As String
    Dim db As DAO.Database
    
    Set db = CurrentDb
    Set dialog = Application.FileDialog(msoFileDialogSaveAs)
    
    With dialog
        .title = "حفظ التقرير كملف PDF"
        .InitialFileName = fileName & ".pdf"
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then
            pdfPath = .SelectedItems(1)
            If LCase(Right(pdfPath, 4)) <> ".pdf" Then
                pdfPath = pdfPath & ".pdf"
            End If
            DoCmd.OutputTo acOutputReport, rptName, acFormatPDF, pdfPath, False
            MsgBox "تم تصدير التقرير بنجاح كملف PDF", vbInformation + vbMsgBoxRight, "نجاح التصدير"
        Else
            db.Execute "DELETE FROM Tbl_Temp", dbFailOnError
            MsgBox "تم إلغاء عملية التصدير", vbInformation + vbMsgBoxRight, "إلغاء التصدير"
            DoCmd.Close acReport, rptName
        End If
    End With
    
    Set dialog = Nothing
End Sub

 

ثم في زر جديد كما في المرفق ( تستطيع تغييره كما تريد ) / الصق الاستدعاء كالتالي :-

Private Sub Bth_PDF_Click()
    Dim rptName As String
    Dim fileName As String
    If IsNull(Me.x_tkrer) Or Trim(Me.x_tkrer) = "" Then
        MsgBox "يرجى اختيار اسم التقرير قبل التصدير.", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    Select Case Me.x_tkrer
        Case "كشف الحوافز"
            rptName = "rep1"
        Case "استمارة الصرف"
            rptName = "rep50"
        Case Else
            MsgBox "ليس هناك تقرير بهذا الإسم", vbExclamation + vbMsgBoxRight, ""
            Exit Sub
    End Select
    fileName = Me.x_tkrer
    DoCmd.OpenReport rptName, acViewPreview
    ExportReportToPDF rptName, fileName
End Sub

وتستطيع إضافة أكثر من تقرير كما تريد مع استعمال الدالة Case بدلاً من IF الشرطية ...

* ملاحظة ,, قم بإضافة المكتبة التالية حسب اصدار الأوفيس لديك :-

وهذه فكرتي ، تفضل :-

برنامج الحوافز.accdb

 

تم تعديل فبراير 14 بواسطه Foksh
إضافة صورة

[The best]

8 دقائق مضت, Foksh said:

وعليكم السلام ورحمة الله وبركاته ,,

 

في مديول عام ، الصق هذا الكود :-

Option Compare Database
Option Explicit

Public pdfPathGlobal As String
Public rptNameGlobal As String

Public Sub ExportReportToPDF(rptName As String, fileName As String)
    On Error Resume Next
    Dim dialog As FileDialog
    Dim pdfPath As String
    Dim db As DAO.Database
    
    Set db = CurrentDb
    Set dialog = Application.FileDialog(msoFileDialogSaveAs)
    
    With dialog
        .title = "حفظ التقرير كملف PDF"
        .InitialFileName = fileName & ".pdf"
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then
            pdfPath = .SelectedItems(1)
            If LCase(Right(pdfPath, 4)) <> ".pdf" Then
                pdfPath = pdfPath & ".pdf"
            End If
            DoCmd.OutputTo acOutputReport, rptName, acFormatPDF, pdfPath, False
            MsgBox "تم تصدير التقرير بنجاح كملف PDF", vbInformation + vbMsgBoxRight, "نجاح التصدير"
        Else
            db.Execute "DELETE FROM Tbl_Temp", dbFailOnError
            MsgBox "تم إلغاء عملية التصدير", vbInformation + vbMsgBoxRight, "إلغاء التصدير"
            DoCmd.Close acReport, rptName
        End If
    End With
    
    Set dialog = Nothing
End Sub

 

ثم في زر جديد كما في المرفق ( تستطيع تغييره كما تريد ) / الصق الاستدعاء كالتالي :-

Private Sub Bth_PDF_Click()
    Dim rptName As String
    Dim fileName As String
    If IsNull(Me.x_tkrer) Or Trim(Me.x_tkrer) = "" Then
        MsgBox "يرجى اختيار اسم التقرير قبل التصدير.", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    Select Case Me.x_tkrer
        Case "كشف الحوافز"
            rptName = "rep1"
        Case "استمارة الصرف"
            rptName = "rep50"
        Case Else
            MsgBox "ليس هناك تقرير بهذا الإسم", vbExclamation + vbMsgBoxRight, ""
            Exit Sub
    End Select
    fileName = Me.x_tkrer
    DoCmd.OpenReport rptName, acViewPreview
    ExportReportToPDF rptName, fileName
End Sub

وتستطيع إضافة أكثر من تقرير كما تريد مع استعمال الدالة Case بدلاً من IF الشرطية ...

* ملاحظة ,, قم بإضافة المكتبة التالية حسب اصدار الأوفيس لديك :-

وهذه فكرتي ، تفضل :-

برنامج الحوافز.accdb 1.54 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 1 download

 

جهد مشكور أخى لكن عند ملاحظة عند تنفيذ الإجراء يتم فتح نافذة لاختيار مكان الحفظ كما يتم أيضا فتح التقرير.. هل يمكن الحفظ مباشرة فى مجلد البرنامج دون فتح التقرير مع العلم إن البرنامج عندى فى مجلد E

[Foksh]

منذ ساعه, The best said:

يمكن الحفظ مباشرة فى مجلد البرنامج دون فتح التقرير مع العلم إن البرنامج عندى فى مجلد E

بما انني ابتعدت عن الكمبيوتر ، جرب هذا التعديل ، اولاً على دالة المديول :-

Public Sub ExportReportToPDF(rptName As String, fileName As String)
    On Error Resume Next
    Dim pdfPath As String
    pdfPath = CurrentProject.Path & "\" & fileName & ".pdf"
    DoCmd.OpenReport rptName, acViewReport, , , acHidden
    DoCmd.OutputTo acOutputReport, rptName, acFormatPDF, pdfPath, False
    DoCmd.Close acReport, rptName, acSaveNo
    MsgBox "تم تصدير التقرير بنجاح إلى: " & vbCrLf & pdfPath, vbInformation, "نجاح التصدير"
End Sub

 

في زر الـ PDF :-

Private Sub Bth_PDF_Click()
    Dim rptName As String, fileName As String
    If IsNull(Me.x_tkrer) Or Trim(Me.x_tkrer) = "" Then
        MsgBox "يرجى اختيار اسم التقرير قبل التصدير.", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    Select Case Me.x_tkrer
        Case "كشف الحوافز": rptName = "rep1"
        Case "استمارة الصرف": rptName = "rep50"
        Case Else
            MsgBox "ليس هناك تقرير بهذا الإسم", vbExclamation + vbMsgBoxRight, ""
            Exit Sub
    End Select
    fileName = Me.x_tkrer
    DoCmd.OpenReport rptName, acViewReport, , , acHidden
    ExportReportToPDF rptName, fileName
End Sub

 

جرب وأخبرني بالنتيجة 🤗 .

 

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