تعديل على كود لفتح التقارير كأنها PDF

**jo_2010** · يناير 26

الخبراء الافاضل

بعد التحية

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

اريد التعديل على هذا الكود لفتح هذة التقارير كانها pdf اليكم الكود

 DoCmd.OpenReport "Y_N_Report", acViewPreview, , "ddate = #" & Format([DDate], "yyyy-mm-dd") & "# AND NOT IsNull(colour)", , Screen.ActiveControl.Caption

خالص الشكر لمساعدتكم

**kkhalifa1960** · يناير 26

Dim FileName As String

' نأخذ الـ Caption من الـ Control النشط ونستخدمه كاسم للملف
FileName = "C:\Reports\" & Screen.ActiveControl.Caption & "_" & Format([DDate], "yyyymmdd") & ".pdf"

' فتح التقرير في الخلفية مع الشرط
DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
    "ddate = #" & Format([DDate], "yyyy-mm-dd") & "# AND NOT IsNull(colour)", , acHidden

' تصدير التقرير إلى PDF بالاسم الديناميكي
DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, FileName, False

' إغلاق التقرير بعد التصدير
DoCmd.Close acReport, "Y_N_Report"

السابق يحفظ بمجلد (Reports) بالمسار (C)

Dim FileName As String

' تكوين اسم الملف بجوار القاعدة
FileName = CurrentProject.Path & "\" & Screen.ActiveControl.Caption & "_" & Format([DDate], "yyyymmdd") & ".pdf"

' فتح التقرير في الخلفية مع الشرط المطلوب
DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
    "ddate = #" & Format([DDate], "yyyy-mm-dd") & "# AND NOT IsNull(colour)", , acHidden

' تصدير التقرير إلى PDF بالاسم الديناميكي بجوار القاعدة
DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, FileName, False

' إغلاق التقرير بعد التصدير
DoCmd.Close acReport, "Y_N_Report"

السابق يحفظ بجوار القاعدة

تم تعديل يناير 26 بواسطه kkhalifa1960

**jo_2010** · يناير 26

معلمى الفاضل

اليكم القاعدة للتعديل عليها

JOOO.rar

تم تعديل يناير 26 بواسطه jo_2010

**kkhalifa1960** · يناير 27

تفضل استاذ @jo_2010 المرفق بعد التعديل بطلبك . ووافني بالرد . :fff:

JOOO-1.rar

**jo_2010** · يناير 27

معلمى الفاضل

شكرا لا بداعك منقطع النظير

لى 3 طلبات اخبرة

Case 102
            Me.Refresh

            sPDF = sFolder & "\Report_" & Me.PCode & "_" & _
                   Format(Date, "yyyy-mm-dd") & ".pdf"

            DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
                "[PCode]=" & Me.PCode, , _
                sSubReport

            DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False
            DoCmd.Close acReport, "Y_N_Report"

1_تعديل الكود دة بحيث يتم تصدير التقرير باسم المريض تم التاريخ

مثال الاسم ثم التاريخ بدون كلمة Report

21/1/2026 _ احمد محمد على

2_كما ارجو فتح التقارير فى وضع مختفى

3_وفتح التقرير كPDF بعد التصدير

تم تعديل يناير 27 بواسطه jo_2010

**kkhalifa1960** · يناير 28

تفضل استاذ @jo_2010 الكود بعد التعديل بطلبك ومجرب . ووافني بالرد . :fff:

Case 102
    Me.Refresh

    Dim PatientName As String
    Dim FileDate As String

    ' اسم المريض
    PatientName = Me.Pname

    ' تنظيف الاسم من الرموز غير المسموح بها في أسماء الملفات
    PatientName = Replace(PatientName, "/", "-")
    PatientName = Replace(PatientName, "\", "-")
    PatientName = Replace(PatientName, ":", "-")

    ' تنسيق التاريخ
    FileDate = Format(Date, "dd-mm-yyyy")

    ' مسار واسم ملف الـ PDF (اسم المريض ثم التاريخ)
    sPDF = sFolder & "\" & PatientName & "_" & FileDate & ".pdf"

    ' فتح التقرير بشكل مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "[PCode]=" & Me.PCode, acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

**kkhalifa1960** · يناير 28

ولو عاوز حالة التقارير كلها فتح التقارير كلها فى وضع مختفى وفتحها كPDF بعد التصدير اليك كود الزر كامل .

Private Sub أمر1595_Click()

    Dim TaskDialog As Y_CTaskDialog
    Set TaskDialog = New Y_CTaskDialog

    Dim sSubReport As String
    sSubReport = Screen.ActiveControl.Caption

    ' مسار التصدير
    Dim sBasePath As String
    Dim sFolder As String
    Dim sPDF As String

    sBasePath = CurrentProject.Path
    sFolder = sBasePath & "\MyReports"

    ' إنشاء المجلد إن لم يكن موجودًا
    If Dir(sFolder, vbDirectory) = "" Then
        MkDir sFolder
    End If

    With TaskDialog
        .Init
        .ParenthWnd = Me.hwnd

        .Flags = TDF_RTL_LAYOUT Or TDF_USE_COMMAND_LINKS _
                 Or TDF_USE_IMAGERES_ICONID_BUTTON

        .AddCustomButton 101, _
            " طبـاعـة كـل التقـارير بتاريخ " & " /   " & DDate & vbLf & _
            " عدد التقارير     " & URn & "    تقرير ", 5380

        .AddCustomButton 102, _
            " طبـاعـة تقــريــــر واحــــد " & vbLf & _
            " باســــم  /  " & PNAME & " ", 5351

        .AddCustomButton 103, _
            " تــراجــــــع عـن الطبــاعـة ", 5315

        .SetWindowsButtonIconSize 32
        .MainInstruction = "جمعية حماية البيئة من التلوث"
        .Content = "معمـل الام والطفــل"
        .IconMain = 76
        .Title = "طباعـــة"
        .Width = 250

        .ShowDialog

        Select Case .ResultMain

        ' ===== الحالة 101 =====
Case 101
    Me.Refresh

    ' مسار واسم ملف PDF
    sPDF = sFolder & "\AllReports_" & _
           Format(Me.DDate, "yyyy-mm-dd") & ".pdf"

    ' فتح التقرير في وضع مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "ddate = #" & Format(Me.DDate, "yyyy-mm-dd") & "# AND NOT IsNull(colour)", _
        acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

        ' ===== الحالة 102 =====
        Case 102
    Me.Refresh

    Dim PatientName As String
    Dim FileDate As String

    ' اسم المريض
    PatientName = Me.PNAME

    ' تنظيف الاسم من الرموز غير المسموح بها في أسماء الملفات
    PatientName = Replace(PatientName, "/", "-")
    PatientName = Replace(PatientName, "\", "-")
    PatientName = Replace(PatientName, ":", "-")

    ' تنسيق التاريخ
    FileDate = Format(Date, "dd-mm-yyyy")

    ' مسار واسم ملف الـ PDF (اسم المريض ثم التاريخ)
    sPDF = sFolder & "\" & PatientName & "_" & FileDate & ".pdf"

    ' فتح التقرير بشكل مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "[PCode]=" & Me.PCode, acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

        Case 103
            Exit Sub
        End Select
    End With
    Set TaskDialog = Nothing
End Sub

**jo_2010** · يناير 28

14 ساعات مضت, kkhalifa1960 said:

ولو عاوز حالة التقارير كلها فتح التقارير كلها فى وضع مختفى وفتحها كPDF بعد التصدير اليك كود الزر كامل .

Private Sub أمر1595_Click()

    Dim TaskDialog As Y_CTaskDialog
    Set TaskDialog = New Y_CTaskDialog

    Dim sSubReport As String
    sSubReport = Screen.ActiveControl.Caption

    ' مسار التصدير
    Dim sBasePath As String
    Dim sFolder As String
    Dim sPDF As String

    sBasePath = CurrentProject.Path
    sFolder = sBasePath & "\MyReports"

    ' إنشاء المجلد إن لم يكن موجودًا
    If Dir(sFolder, vbDirectory) = "" Then
        MkDir sFolder
    End If

    With TaskDialog
        .Init
        .ParenthWnd = Me.hwnd

        .Flags = TDF_RTL_LAYOUT Or TDF_USE_COMMAND_LINKS _
                 Or TDF_USE_IMAGERES_ICONID_BUTTON

        .AddCustomButton 101, _
            " طبـاعـة كـل التقـارير بتاريخ " & " /   " & DDate & vbLf & _
            " عدد التقارير     " & URn & "    تقرير ", 5380

        .AddCustomButton 102, _
            " طبـاعـة تقــريــــر واحــــد " & vbLf & _
            " باســــم  /  " & PNAME & " ", 5351

        .AddCustomButton 103, _
            " تــراجــــــع عـن الطبــاعـة ", 5315

        .SetWindowsButtonIconSize 32
        .MainInstruction = "جمعية حماية البيئة من التلوث"
        .Content = "معمـل الام والطفــل"
        .IconMain = 76
        .Title = "طباعـــة"
        .Width = 250

        .ShowDialog

        Select Case .ResultMain

        ' ===== الحالة 101 =====
Case 101
    Me.Refresh

    ' مسار واسم ملف PDF
    sPDF = sFolder & "\AllReports_" & _
           Format(Me.DDate, "yyyy-mm-dd") & ".pdf"

    ' فتح التقرير في وضع مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "ddate = #" & Format(Me.DDate, "yyyy-mm-dd") & "# AND NOT IsNull(colour)", _
        acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

        ' ===== الحالة 102 =====
        Case 102
    Me.Refresh

    Dim PatientName As String
    Dim FileDate As String

    ' اسم المريض
    PatientName = Me.PNAME

    ' تنظيف الاسم من الرموز غير المسموح بها في أسماء الملفات
    PatientName = Replace(PatientName, "/", "-")
    PatientName = Replace(PatientName, "\", "-")
    PatientName = Replace(PatientName, ":", "-")

    ' تنسيق التاريخ
    FileDate = Format(Date, "dd-mm-yyyy")

    ' مسار واسم ملف الـ PDF (اسم المريض ثم التاريخ)
    sPDF = sFolder & "\" & PatientName & "_" & FileDate & ".pdf"

    ' فتح التقرير بشكل مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "[PCode]=" & Me.PCode, acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

        Case 103
            Exit Sub
        End Select
    End With
    Set TaskDialog = Nothing
End Sub

الخبير الفاضل ومعلمى الجليل

شكرا لاجل تعبك

ولكنى اريد الاسم قبل التاريخ انظر الصورة

**kkhalifa1960** · يناير 28

تفضل استاذ @jo_2010 كود الزر بعد التعديل بطلبك .ووافني بالرد . :fff:

Private Sub أمر1595_Click()

    Dim TaskDialog As Y_CTaskDialog
    Set TaskDialog = New Y_CTaskDialog

    Dim sSubReport As String
    sSubReport = Screen.ActiveControl.Caption

    ' مسار التصدير
    Dim sBasePath As String
    Dim sFolder As String
    Dim sPDF As String

    sBasePath = CurrentProject.Path
    sFolder = sBasePath & "\MyReports"

    ' إنشاء المجلد إن لم يكن موجودًا
    If Dir(sFolder, vbDirectory) = "" Then
        MkDir sFolder
    End If

    With TaskDialog
        .Init
        .ParenthWnd = Me.hwnd

        .Flags = TDF_RTL_LAYOUT Or TDF_USE_COMMAND_LINKS _
                 Or TDF_USE_IMAGERES_ICONID_BUTTON

        .AddCustomButton 101, _
            " طبـاعـة كـل التقـارير بتاريخ " & " /   " & DDate & vbLf & _
            " عدد التقارير     " & URn & "    تقرير ", 5380

        .AddCustomButton 102, _
            " طبـاعـة تقــريــــر واحــــد " & vbLf & _
            " باســــم  /  " & PNAME & " ", 5351

        .AddCustomButton 103, _
            " تــراجــــــع عـن الطبــاعـة ", 5315

        .SetWindowsButtonIconSize 32
        .MainInstruction = "جمعية حماية البيئة من التلوث"
        .Content = "معمـل الام والطفــل"
        .IconMain = 76
        .Title = "طباعـــة"
        .Width = 250

        .ShowDialog

        Select Case .ResultMain

        ' ===== الحالة 101 =====
Case 101
    Me.Refresh

    ' مسار واسم ملف PDF
    sPDF = sFolder & "\AllReports_" & _
           Format(Me.DDate, "yyyy-mm-dd") & ".pdf"

    ' فتح التقرير في وضع مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "ddate = #" & Format(Me.DDate, "yyyy-mm-dd") & "# AND NOT IsNull(colour)", _
        acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

        ' ===== الحالة 102 =====
Case 102
    Me.Refresh

    Dim PatientName As String
    Dim FileDate As String
    Dim RLM As String
    Dim LRM As String

    RLM = ChrW(&H200F) ' Right-To-Left Mark
    LRM = ChrW(&H200E) ' Left-To-Right Mark

    ' اسم المريض
    PatientName = Me.PNAME

    ' تنظيف الرموز غير المسموحة
    PatientName = Replace(PatientName, "/", "-")
    PatientName = Replace(PatientName, "\", "-")
    PatientName = Replace(PatientName, ":", "-")

    ' التاريخ
    FileDate = Format(Date, "dd-MM-yyyy")

    ' اسم الملف (اتجاه مضبوط 100%)
    sPDF = sFolder & "\" & _
           RLM & PatientName & RLM & "_" & LRM & FileDate & ".pdf"

    ' فتح التقرير بشكل مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "[PCode]=" & Me.PCode, acHidden, sSubReport

    ' تصدير PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF
    Application.FollowHyperlink sPDF

        Case 103
            Exit Sub

        End Select

    End With

    Set TaskDialog = Nothing


End Sub

تم تعديل يناير 28 بواسطه kkhalifa1960

**jo_2010** · يناير 29

في 28‏/1‏/2026 at 08:23, kkhalifa1960 said:

تفضل استاذ @jo_2010 كود الزر بعد التعديل بطلبك .ووافني بالرد . :fff:

Private Sub أمر1595_Click()

    Dim TaskDialog As Y_CTaskDialog
    Set TaskDialog = New Y_CTaskDialog

    Dim sSubReport As String
    sSubReport = Screen.ActiveControl.Caption

    ' مسار التصدير
    Dim sBasePath As String
    Dim sFolder As String
    Dim sPDF As String

    sBasePath = CurrentProject.Path
    sFolder = sBasePath & "\MyReports"

    ' إنشاء المجلد إن لم يكن موجودًا
    If Dir(sFolder, vbDirectory) = "" Then
        MkDir sFolder
    End If

    With TaskDialog
        .Init
        .ParenthWnd = Me.hwnd

        .Flags = TDF_RTL_LAYOUT Or TDF_USE_COMMAND_LINKS _
                 Or TDF_USE_IMAGERES_ICONID_BUTTON

        .AddCustomButton 101, _
            " طبـاعـة كـل التقـارير بتاريخ " & " /   " & DDate & vbLf & _
            " عدد التقارير     " & URn & "    تقرير ", 5380

        .AddCustomButton 102, _
            " طبـاعـة تقــريــــر واحــــد " & vbLf & _
            " باســــم  /  " & PNAME & " ", 5351

        .AddCustomButton 103, _
            " تــراجــــــع عـن الطبــاعـة ", 5315

        .SetWindowsButtonIconSize 32
        .MainInstruction = "جمعية حماية البيئة من التلوث"
        .Content = "معمـل الام والطفــل"
        .IconMain = 76
        .Title = "طباعـــة"
        .Width = 250

        .ShowDialog

        Select Case .ResultMain

        ' ===== الحالة 101 =====
Case 101
    Me.Refresh

    ' مسار واسم ملف PDF
    sPDF = sFolder & "\AllReports_" & _
           Format(Me.DDate, "yyyy-mm-dd") & ".pdf"

    ' فتح التقرير في وضع مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "ddate = #" & Format(Me.DDate, "yyyy-mm-dd") & "# AND NOT IsNull(colour)", _
        acHidden, sSubReport

    ' تصدير التقرير إلى PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF بعد التصدير
    Application.FollowHyperlink sPDF

        ' ===== الحالة 102 =====
Case 102
    Me.Refresh

    Dim PatientName As String
    Dim FileDate As String
    Dim RLM As String
    Dim LRM As String

    RLM = ChrW(&H200F) ' Right-To-Left Mark
    LRM = ChrW(&H200E) ' Left-To-Right Mark

    ' اسم المريض
    PatientName = Me.PNAME

    ' تنظيف الرموز غير المسموحة
    PatientName = Replace(PatientName, "/", "-")
    PatientName = Replace(PatientName, "\", "-")
    PatientName = Replace(PatientName, ":", "-")

    ' التاريخ
    FileDate = Format(Date, "dd-MM-yyyy")

    ' اسم الملف (اتجاه مضبوط 100%)
    sPDF = sFolder & "\" & _
           RLM & PatientName & RLM & "_" & LRM & FileDate & ".pdf"

    ' فتح التقرير بشكل مخفي
    DoCmd.OpenReport "Y_N_Report", acViewPreview, , _
        "[PCode]=" & Me.PCode, acHidden, sSubReport

    ' تصدير PDF
    DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False

    ' إغلاق التقرير
    DoCmd.Close acReport, "Y_N_Report"

    ' فتح ملف الـ PDF
    Application.FollowHyperlink sPDF

        Case 103
            Exit Sub

        End Select

    End With

    Set TaskDialog = Nothing


End Sub

شكرا ايها الخبير المبدع

جزاك الله بكل الخير وزادك من علمه

تم تعديل يناير 29 بواسطه jo_2010

تسجيل الدخول

تعديل على كود لفتح التقارير كأنها PDF

الردود الموصى بها

jo_2010

kkhalifa1960

jo_2010

kkhalifa1960

jo_2010

kkhalifa1960

kkhalifa1960

jo_2010

kkhalifa1960

jo_2010

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information