طباعة معلومات المنتج على ورقة PDF باستعمال الكود VBA

[BAbGHDADI]

السلام عليكم اخوتي المرجو منكم المساعدة

لقد قمت بعمل classeur يحتوي على Feuil1 و Feuil2

في Feuil1 توجد معلومات المنتجات والتي تنتهي في السطر 138

وفي Feuil2 توجد ورقة A4 تحتوي على معلومات من Feuil1.(من السطر 2 الى السطر 49)

* كيف يمكن طباعة ملف pdf من Feuil2 . والذهاب الى Feuil1 ومسح المجموعة الاولى المتكونة من 48 سطر (اللون الاصفر).

ونقوم بترحيل المجموعة التانية (اللون الازرق)  الى المكان الدى كانت فيه المجموعة الاولى . 

لكي تظهر في Feuil2 . ونقوم مرة اخرى بطباعة Feuil2 ...

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

A4 VERSION.xlsm

[Ali Mohamed Ali]

وعليكم السلام-تفضل هذا الكود

Sub PrintPDF()
    Call Save_PDF
End Sub
Function Save_PDF() As Boolean
    Dim Thissheet As String, ThisFile As String, PathName As String
    Dim SvAs As String
Application.ScreenUpdating = False

    Thissheet = ActiveSheet.Name
    ThisFile = ActiveWorkbook.Name
    PathName = ActiveWorkbook.Path
    SvAs = PathName & "\" & Thissheet & ".pdf"
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0
    On Error GoTo RefLibError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
SaveOnly:
    MsgBox "A copy of this sheet has been successfully saved as a  .pdf  file: " & Chr(13) & Chr(13) & SvAs & _
        "Review the .pdf document. If the document does NOT look good, adjust your printing parameters, and try again."
        
    Save_PDF = True
    GoTo EndMacro
RefLibError:
    MsgBox "Unable to save as PDF. Reference library not found."
    Save_PDF = False
EndMacro:
End Function

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

 

 

Scan1.pdf Scan2.pdf

A4 VERSION1.xlsm