Consulting

Results 1 to 9 of 9

Thread: pdf print from multiple sheet

  1. #1

    pdf print from multiple sheet

    Hello to the forum member

    I have attached one sheet where a macro split the data from main sheet ("Data1") into four different sheets (pfizer, astrazeneca etc)

    Is it possible to develop a macro which will randomly print excel data from all splitted sheet into PDF format with print range(A:N).

    I have entered the header, footer in the "Data1" which are in different language. Is it possible that the developed macro will automatically capture the data from header and footer and print it.

    [[Font size of header=16 and footer is default. header should print system date if possible]]


    Thanks for your help in advance.
    Attached Files Attached Files

  2. #2
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    hi.

    welcome to VBAX.

    try this.

    Sub CreateSheetsFromUniqueValzInCol()
    
    Dim cll As Range
    Dim UqLst As String
    Dim UqArr
    Dim i As Long
    
    
    Application.DisplayAlerts = False
    On Error Resume Next
    
    
    For Each cll In Sheets("Data1").Columns(1).SpecialCells(2).Offset(1)
        If InStr(UqLst, cll.Value) = 0 Then UqLst = UqLst & "|" & cll.Value
    Next
    UqArr = split(Mid(UqLst, 2), "|")
    
    
    For i = LBound(UqArr) To UBound(UqArr)
        Sheets(UqArr(i)).Delete
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = UqArr(i)
        Sheets("Data1").Range("A1").AutoFilter 1, UqArr(i)
        Sheets("Data1").AutoFilter.Range.Copy Sheets(UqArr(i)).Range("A1")
        With Sheets(UqArr(i))
            Application.PrintCommunication = False
            With .PageSetup
                .PrintArea = "$A:$N"
                .PrintTitleRows = "$1:$1"
                .LeftHeader = ""
                .CenterHeader = Sheets("Data1").PageSetup.CenterHeader
                .RightHeader = Sheets("Data1").PageSetup.RightHeader
                .LeftFooter = Sheets("Data1").PageSetup.LeftFooter
                .CenterFooter = ""
                .RightFooter = ""
                .Orientation = xlLandscape
                .FitToPagesWide = 1
            End With
            Application.PrintCommunication = True
            .Columns.AutoFit
            .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & UqArr(i) & ".pdf"
        End With
    Next
    
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  3. #3
    Thanks mancubus for spending your valuable time and looking into my issue.

    I am getting compilation error near the "split" function while running the script. as (Wrong number of arguments or invalid property assignment).

    can you please check once again

    Thanks for your time

  4. #4
    Finally the macro prints for only one sheet. How can I automate for all sheet.
    Please check the attachment
    Sub pdf()
    
    
    Dim lr As Long, lc As Long
    lr = Cells(Rows.Count, 14).End(xlUp).Row
    lc = Cells(Columns.Count, 14).End(xlToLeft).Column
    
    
    With ActiveSheet.PageSetup
                    .PrintArea = "$A:$N"
                    .PrintTitleRows = "$1:$1"
                    .LeftHeader = ""
                    .CenterHeader = Sheets("Data1").PageSetup.CenterHeader
                    .RightHeader = Sheets("Data1").PageSetup.RightHeader
                    .LeftFooter = Sheets("Data1").PageSetup.LeftFooter
                    .CenterFooter = ""
                    .RightFooter = ""
                    .Orientation = xlLandscape
                    .Zoom = False
                    .FitToPagesWide = 1
                    .FitToPagesTall = False
    End With
    
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "a.pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    True
    End Sub
    Attached Files Attached Files

  5. #5
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    this code works for me:
    there are no major changes...


    Sub CreateSheetsFromUniqueValzInColSaveAsPDF()
    
    
        Dim cll As Range
        Dim UqLst As String
        Dim UqArr
        Dim i As Long
        
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With
        
        On Error Resume Next
        
        For Each cll In Sheets("Data1").Columns(1).SpecialCells(2).Offset(1)
            If InStr(UqLst, cll.Value) = 0 Then UqLst = UqLst & "|" & cll.Value
        Next
        UqArr = split(Mid(UqLst, 2), "|")
        
        For i = LBound(UqArr) To UBound(UqArr)
            Sheets(UqArr(i)).Delete
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = UqArr(i)
            With Sheets("Data1")
                .Range("A1").AutoFilter 1, UqArr(i)
                .AutoFilter.Range.Copy Sheets(UqArr(i)).Range("A1")
            End With
            With Sheets(UqArr(i))
                Application.PrintCommunication = False
                With .PageSetup
                    .PrintArea = "$A:$N"
                    .PrintTitleRows = "$1:$1"
                    .LeftHeader = ""
                    .CenterHeader = Sheets("Data1").PageSetup.CenterHeader
                    .RightHeader = Sheets("Data1").PageSetup.RightHeader
                    .LeftFooter = Sheets("Data1").PageSetup.LeftFooter
                    .CenterFooter = ""
                    .RightFooter = ""
                    .Orientation = xlLandscape
                    .FitToPagesWide = 1
                End With
                Application.PrintCommunication = True
                .Columns.AutoFit
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & UqArr(i) & ".pdf"
            End With
        Next
        
        With Sheets("Data1")
            .Activate
            .ShowAllData
        End With
    
    
    End Sub
    Attached Files Attached Files
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  6. #6
    system date is not populated to the right section of header in PDF file . Is it possible to set only the header center font size to 16.(Default font for footer and other)

    Thanks in advance

  7. #7
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    i cant say anything about that. because the code adds date into header when i run it and i can see it in pdf file.

    VBAX does not allow me to upload PDF files. but when i open the PDF file created by macro, i can see the current date in header.
    .
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  8. #8
    Thank you so much for your great help.

  9. #9
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    you are welcome. i'm glad it helped.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •