VBA Code Update Save as PDF

[Jimmypop]

Good day all

Some assistance required...

I have the following code...

Sub Export_To_PDF()
    Dim WBName, FilePath As String
    WBName = ActiveWorkbook.Name
    FilePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & WBName & ".pdf"
    MsgBox "This report will now be published To your Desktop As a .pdf File", vbInformation, "Message from Admin..."
    ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
    ActiveSheet.ExportAsFixedFormat _
                                    Type:=xlTypePDF, _
                                    Filename:=FilePath, _
                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, OpenAfterPublish:=True
    Worksheets("Sheet1").Select
End Sub

Now... How can I update the code to have it select only the visible cells on Sheet1 and the entire Sheet2 and then export to pdf... Currently it exports the entire Sheet1 but would like to have it export only the visible cells and not the hidden ones on Sheet1... So in essence:

1. Select visible cells Sheet1
2. Select entire Sheet2
3. Export the selection to a pdf...

Thanks in advance

 

[Jimmypop]

Ok...after some debugging I found that there was some code interference... Everytime Sheet1 activates there is code running to autofit some rows and columns... I added Application. EnableEvents = False to mitigate this....

Workbook is now exporting only the visible cells I want on Sheet1 and the whole of Sheet2 which in theory means I am almost there...

However... the copy made of Sheet1 does not copy shapes and images.... In my post #6 I know I said it is copying images... however after all my debugging I realised that it is not grabbing the copy sheet but was grabbing the original, hence the presence of the images...

Now i went and manually said make a copy of Sheet1 after Sheet1 and even this does not copy images and shapes

 

[Jimmypop]

UPDATE... working now...


Ok so I found the issue that was preventing the copying of the images and shapes. The issue was in my settings. I needed to check "Cut, copy, and sort inserted objects with their parent cells" under "Cut, copy, and paste" in the Advanced options. Not sure why this was turned off seeing as to my knowledge it should be on by default. So, then I sat with an issue by not knowing if other users setting was the same. I overcame this by adding Application.CopyObjectsWithCells = True. I also did not set it to false again on purpose seeing as most of our excel documents and procedures in the company works by copying and pasting. So, this should prevent user from having to set this in settings every time before use.

There were also some places I needed to lock and unlock the sheet and prevent other code from running for this routine of exporting to pdf.

@bferraz thanks for the assistance given... updated code below

Sub Export_To_PDF()
    Application.DisplayAlerts = False
    Application.CopyObjectsWithCells = True
    Dim ws, ws1     As Worksheet
    Dim lastRow, lastCol As Long
    Dim WBName, FilePath As String
    Dim wsList      As Variant
    With ThisWorkbook
        Set ws1 = .Sheets("Sheet1")
        ws1.Copy After:=ws1
        Set ws = .Sheets(ws1.Index + 1)
    End With
    ActiveSheet.Unprotect "somepassword"
    lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
    lastCol = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
    For i = lastRow To 1 Step -1
        If ws.Rows(i).Hidden = True Then ws.Rows(i).EntireRow.Delete
    Next
    For i = lastCol To 1 Step -1
        If ws.Columns(i).Hidden = True Then ws.Columns(i).EntireColumn.Delete
    Next
    WBName = ActiveWorkbook.Name
    FilePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & WBName & ".pdf"
    MsgBox "This report will now be published To your Desktop As a .pdf File", vbInformation, "Message from Admin..."
    wsList = Array(ws.Name, "Sheet2")
    Application.EnableEvents = False
    ThisWorkbook.Sheets(wsList).Select
    ActiveSheet.ExportAsFixedFormat _
                                    Type:=xlTypePDF, _
                                    Filename:=FilePath, _
                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, OpenAfterPublish:=True
    Worksheets("Sheet1").Select
    ws.Delete
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    ActiveSheet.Protect "somepassword"
End Sub

 

[bferraz]

UPDATE... working now...


Ok so I found the issue that was preventing the copying of the images and shapes. The issue was in my settings. I needed to check "Cut, copy, and sort inserted objects with their parent cells" under "Cut, copy, and paste" in the Advanced options. Not sure why this was turned off seeing as to my knowledge it should be on by default. So, then I sat with an issue by not knowing if other users setting was the same. I overcame this by adding Application.CopyObjectsWithCells = True. I also did not set it to false again on purpose seeing as most of our excel documents and procedures in the company works by copying and pasting. So, this should prevent user from having to set this in settings every time before use.

There were also some places I needed to lock and unlock the sheet and prevent other code from running for this routine of exporting to pdf.

@bferraz thanks for the assistance given... updated code below

Sub Export_To_PDF()
    Application.DisplayAlerts = False
    Application.CopyObjectsWithCells = True
    Dim ws, ws1     As Worksheet
    Dim lastRow, lastCol As Long
    Dim WBName, FilePath As String
    Dim wsList      As Variant
    With ThisWorkbook
        Set ws1 = .Sheets("Sheet1")
        ws1.Copy After:=ws1
        Set ws = .Sheets(ws1.Index + 1)
    End With
    ActiveSheet.Unprotect "somepassword"
    lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
    lastCol = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
    For i = lastRow To 1 Step -1
        If ws.Rows(i).Hidden = True Then ws.Rows(i).EntireRow.Delete
    Next
    For i = lastCol To 1 Step -1
        If ws.Columns(i).Hidden = True Then ws.Columns(i).EntireColumn.Delete
    Next
    WBName = ActiveWorkbook.Name
    FilePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & WBName & ".pdf"
    MsgBox "This report will now be published To your Desktop As a .pdf File", vbInformation, "Message from Admin..."
    wsList = Array(ws.Name, "Sheet2")
    Application.EnableEvents = False
    ThisWorkbook.Sheets(wsList).Select
    ActiveSheet.ExportAsFixedFormat _
                                    Type:=xlTypePDF, _
                                    Filename:=FilePath, _
                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, OpenAfterPublish:=True
    Worksheets("Sheet1").Select
    ws.Delete
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    ActiveSheet.Protect "somepassword"
End Sub

You are welcome, mate!
I'm happy you figured that out. =)