pdf عندى زرار عايزاه يعمل تصدير ريبورت الى

[safaa salem5]

بشرط ان التقرير يتم تصديره الى مسار البرنامج الحالى حتى مع تغيير المستخدمين لمكان احتفاظهم بالبرنامج

 

 

 

عايزه نتيجة كل مريض تتخزن فى فولدر  بكود المريض

ID

 داخل فولدر اسمه

 results

هيكون موجود داخل ملفات البرنامج

وعايزه اسم التقرير يحتوى على اسم المريض

PNAME

مع كود المريض

ID

مع اسم مجموعة التحاليل

SUB

تم تعديل يونيو 11 بواسطه safaa salem5

[safaa salem5]

Dim Project_path, Dir_File As String Project_path = DLookup("[Folder_Path]", "tbl_msar_folder", "[Auto_ID]=1") Dir_File = Project_path & "\ملفات تم تصديرها\" DoCmd.OutputTo acOutputForm, "تذاكر_نموذج_استعلام", "PDFFormat(*.pdf)", Dir_File & "تذاكر " & Format(Now, "DD-MM-YYYY") & ".pdf", False

انا لقيت كود للاخ ناقل بس محتاج تعديل

[ابو جودي]

ممكن نفكر بصوت عالى 

انا موافق بعمل الاتى 

فى المجلد الاساسى الحالى لقاعدة البيانات يتم عمل مجلد باسم results
وبداخل المجلد results يتم عمل مجلد ID لكود المريض  مع اسم المريض
وبداخل مجلد ID يتم عمل مجلد بكود الزيارة او بالتاريخ لسهولة تتبع التقارير مستقبلا من المجلدات حتى وبدون فتح قاعدة البيانات

ايه راي حضرتك يا دكتور ؟؟

واعتقد اسم التقرير فقط مجموعة التحاليل يكون افضل 

 

[safaa salem5]

1 minute ago, ابو جودي said:

فى المجلد الاساسى الحالى لقاعدة البيانات يتم عمل مجلد باسم results

ما هو فعلا فيه مجلد معمول جاهز بالاسم دا فى البرنامج

4 minutes ago, ابو جودي said:

وبداخل مجلد ID يتم عمل مجلد بكود الزيارة او بالتاريخ لسهولة تتبع التقارير مستقبلا من المجلدات حتى وبدون فتح قاعدة البيانات

تمام كد بس ياريت تسمية الريبورت  بالاسم مع ال

ID

مع محتويات التقرير من تحاليل اللى هى SUB TEST

لان نفس المريض ممكن يتم عمل تصدير لتحاليل اخرى فى ريبورتات مختلفه

لذا وجب تسمية الريبورت بنوع التحليل

[ابو جودي]

طيب وحتى لا يقال اننى ناقل عن الاستاذ @ناقل  لن اقوم بتعديل الاكواد

 

 

انا معقد و افضل العمل دائما وفق مرونة واحترافية بقدر الامكان 

وفقا لذلك هذه طريقتى 

اولا عمل موديول باسم : basExportReportToPDF

الاكواد فى الموديول 

Option Compare Database
Option Explicit

' Function to create directories if they do not exist
Public Function CreateDirectoryIfNotExists(ByVal path As String)
    If Dir(path, vbDirectory) = "" Then
        MkDir path
    End If
End Function

' Function to export report to PDF
Public Function ExportReportToPDF(ByVal patientID As String, ByVal patientName As String, ByVal visitCode As String, ByVal reportName As String, ByVal outputFileName As String)
    Dim baseFolderPath As String
    Dim resultsFolderPath As String
    Dim patientFolderPath As String
    Dim visitFolderPath As String
    Dim outputFilePath As String

    ' Get the base folder path of the current database
    baseFolderPath = CurrentProject.path
    
    ' Define the path for the results folder
    resultsFolderPath = baseFolderPath & "\results"
    
    ' Create the results folder if it does not exist
    CreateDirectoryIfNotExists resultsFolderPath
    
    ' Define the path for the patient folder
    patientFolderPath = resultsFolderPath & "\" & patientID & "_" & patientName
    
    ' Create the patient folder if it does not exist
    CreateDirectoryIfNotExists patientFolderPath
    
    ' Define the path for the visit folder
    visitFolderPath = patientFolderPath & "\" & visitCode
    
    ' Create the visit folder if it does not exist
    CreateDirectoryIfNotExists visitFolderPath
    
    ' Define the output file path
    outputFilePath = visitFolderPath & "\" & outputFileName & ".pdf"
    
    ' Export the report to PDF
    DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, outputFilePath
    
    ' Notify the user
    MsgBox "Report has been exported to: " & outputFilePath, vbInformation
End Function

ثانيا زر امر فى النموذج على ان يكون الكود داخل زر الامر كالاتى 

    Dim patientID As String
    Dim patientName As String
    Dim visitCode As String
    Dim reportName As String
    Dim outputFileName As String

    ' Set the values for the parameters
    patientID = "12345"
    patientName = "Moh3sam"
    visitCode = "2024-06-11"
    reportName = "rptTest"
    outputFileName = "YourOutputFileName"

    ' Call the function to export the report to PDF
    ExportReportToPDF patientID, patientName, visitCode, reportName, outputFileName

 

وطبعا تحياتى وكل تقدير لاستاذى الجليل ومعلمى القدير الاستاذ @ناقل  قطعا بدأت مشاركتى بمداعبة استاذى القدير 

.

وهذه قاعدة البيانات بالتطبيق

 

export report to PDF.accdb

[ناقل]

12 دقائق مضت, ابو جودي said:

طيب وحتى لا يقال اننى ناقل عن الاستاذ @ناقل  لن اقوم بتعديل الاكواد

 

انا كاني سامع حد بينادي .... مين بيتكلم ......

انا اسمي موجود ..... انا هنا .... وانا حاضر يا بشمهندس 

تم تعديل يونيو 11 بواسطه ناقل

[ابو جودي]

7 دقائق مضت, ناقل said:

انا هنا .... وانا حاضر

اسأل الله تعالى ان لا يحرمنا جمعكم الطيب المبارك واتمنى وجودكم فوق رؤوسنا دائما بالخير والصحة وان تكونوا حاضرين متربعين في قلوبنا بكل الحب والمودة 

كل عام وانتم الى الله تعالى اقرب وعلى طاعتة ادوم وباتباع نبينا صل الله علية وعلى اله وصحبة وسلم احرص.. كل عام وانتم بخير

[ناقل]

1 دقيقه مضت, ابو جودي said:

اسأل الله تعالى ان لا يحرمنا جمعكم الطيب المبارك واتمنى وجودكم فوق رؤوسنا دائما بالخير والصحة وان تكونوا حاضرين متربعين في قلوبنا بكل الحب والمودة 

امين ... الله يجمعنا واياكم وجميع المسلمين في الفردوس الاعلى ... على سرر متقابلين ...

الله يديم المحبة اخي الحبيب محمد ...

[ابو جودي]

طيب وبعد وقفة طويلة مع النفس وبعد دعوات استاذى الجبيب الاستاذ @ناقل 

وجدتنى غير راض عن الافكار السابقة لم احس فيها بالمرونة الفائقة فالكود تم تقديمه وفقا لتوجيهات ومتطلبات الدكتورة @safaa salem5 

ولذلك اقدم اليكم الاكواد مرة اخرى بشكل اكثر مرونة لتحقيق اكبر قدر ممكن من الاستفادة بشكل عام مع اى قاعدة وفق اى متغيرات اخرى 

اولا دالة لعمل مجلد او مجلدات وفق الكود التالى
 

' Function to create directories if they do not exist
Public Function CreateDirectories(ByVal basePath As String, ByVal folderNames As String) As String
    Dim fullPath As String
    Dim folderArray() As String
    Dim folderName As Variant
    
    ' Split the folderNames string into an array
    folderArray = Split(folderNames, ",")
    
    fullPath = basePath
    
    ' Loop through each folder name and create the directory if it doesn't exist
    For Each folderName In folderArray
        fullPath = fullPath & "\" & Trim(folderName)
        If Dir(fullPath, vbDirectory) = "" Then
            MkDir fullPath
        End If
    Next folderName
    
    ' Return the final full path
    CreateDirectories = fullPath
End Function

دالة تصدير اى تقرير 
 

' Function to export report to PDF
Public Function ExportReportToPDF(ByVal reportName As String, ByVal outputFilePath As String)
    On Error GoTo ErrorHandler
    
    ' Export the report to PDF
    DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, outputFilePath
    
    ' Notify the user
    MsgBox "Report has been exported to: " & outputFilePath, vbInformation
    Exit Function

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbExclamation
End Function

واخيرا كود زر الامر 
 

    
    Dim baseFolderPath As String
    Dim folderNames As String
    Dim finalFolderPath As String
    Dim outputFilePath As String
    Dim patientID As String
    Dim patientName As String
    Dim visitCodeORvisitDate As String
    Dim reportName As String
    Dim outputFileName As String

    ' Set the values for the parameters
    patientID = "12345"
    patientName = "Moh3sam"
    visitCodeORvisitDate = "2024-06-11"
    outputFileName = "YourOutputFileName"
    
    ' Set the values for the base path and folder names
    baseFolderPath = CurrentProject.path ' The base path of the current database
    folderNames = "results" & "," & patientID & "_" & patientName & "," & visitCodeORvisitDate ' Comma-separated folder names

    ' Create the directories and get the final path
    finalFolderPath = CreateDirectories(baseFolderPath, folderNames)
    
    ' Set the report name and output file path
    reportName = "rptTest" ' The name of the report
    outputFilePath = finalFolderPath & "\" & outputFileName & ".pdf" ' The desired output file name with full path
    
    ' Call the function to export the report to PDF
    ExportReportToPDF reportName, outputFilePath

وهذا المرفق النهائى..

 

 

export report to PDF V. 2.accdb

[الحلبي]

4 ساعات مضت, ابو جودي said:

هذا المرفق النهائى

استاذ فاضل وعبقرى فى حل المواضيع 

انت دكتور هذا المنتدى وتعالج كل رواد المنتدى بعد ان تعمل لهم التحاليل اللازمة

دكتور بمعنى الكلمة ربنا يزرقك ويسهل لك كل امر عسير ويبارك لك فى اولادك