Need assistance getting a pdf created with VBA

OaklandJim

Well-known Member
Joined
Nov 29, 2018
Messages
833
Office Version
  1. 365
Platform
  1. Windows
I am trying to set up a macro that saves parts of a workbook -- portions of two workbooks -- as a PDF.

Here is what I'm trying to create: Correct PDF This was created manually with the print ranges as set (correctly) by my code.

Here is what I get using the code: Incorrect PDF.

What might I try to get the PDF to contain the content desired?

VBA Code:
'For one portfolio worksheet, create a pdf including
'1) summary info for the portfolio (Summary Sheet) and
'2) the portfolio sheet.

Sub SavePortfolioAsPDF(plPortfolioNum)

Debug.Print "plPortfolioNum = " & plPortfolioNum

'   ------------------------
'   ---   Declarations   ---
'   ------------------------

'   Must select sheets. So need to return
'   user to the sheet she was in before.
    Dim wsActive As Worksheet

'   Must use worksheet's name.
'   Cannot use Code Names.
    Dim sSummarySheetName As String
    Dim sPortfolioSheetName As String
    
    Dim sPrintAreaAddress As String
    
    Dim sPortfolioName As String
'
'   Eventually will provide this info as parameters.
    Dim sPath As String
    Dim sFileName As String
    
    Dim sFileSpec As String
    
    Dim sUserName As String

    Dim bUseActiveDir As Boolean
'
    Dim sMsg As String
    Dim vAns As Variant
'
'   -----------------------
'   --- Initializations ---
'   -----------------------
'
    Set wsActive = ActiveSheet
'
'   Use code name to get the name of the Summary worksheet.
    sSummarySheetName = [Summary].Name
    
Debug.Print "sSummarySheetName = " & sSummarySheetName

'   Get 1. the name of the portfolio from Control worksheet
'   and 2. the name of the portfolio worksheet (using code name).
    If plPortfolioNum = 1 _
     Then
        sPortfolioName = [Control].[Portfolio1Name]
        sPortfolioSheetName = [Portfolio1].Name
    Else
        sPortfolioName = [Control].[Portfolio2Name]
        sPortfolioSheetName = [Portfolio2].Name
    End If
    
Debug.Print "sPortfolioSheetName = " & sPortfolioSheetName
    
'   Establish the name of the file to save.
    sFileName = Format(Now(), "mm-dd-yy") & "_" & sPortfolioName & ".pdf"

Debug.Print "sFileName = " & sFileName
    
'   Ask user about which directory to use. . Either 1. Desktop or 2. Thisworkbook.path
    sMsg = "Use current directory [Yes] or Desktop [No]?"

    vAns = MsgBox(sMsg, vbQuestion + vbYesNoCancel, "Save PDF of Portfolio Data")
    If vAns = vbYes _
     Then
        bUseActiveDir = True
     ElseIf vAns = vbNo _
      Then
        bUseActiveDir = False
     Else
        GoTo Closeout
     End If

'   Specify the path where file is to be saved. Either 1. Desktop or 2. Thisworkbook.path
    If bUseActiveDir _
     Then
        sPath = ThisWorkbook.Path & "\"
    Else
        
        sUserName = GetUserName()
        
        sPath = "C:\Users\" & sUserName & "\Desktop\"
        
        If Not DirExists(sPath) _
         Then
            MsgBox "Cannot find desktop directory " & Chr(10) & sPath, vbOK, "Creating PDF"
            Exit Sub
        End If
        
    End If
    
Debug.Print "sPath = " & sPath
    
'   Get path to and name of the file.
    sFileSpec = sPath & sFileName

'   Default is to overwrite the existing file if it exists.
    vAns = vbYes
    
    If Dir(sFileSpec) <> "" _
     Then
        vAns = MsgBox("Overwrite the existing file?", vbQuestion + vbYesNoCancel, "Save PDF of Portfolio Data")
    End If 'FileExists(sPath & sFileName)

    If vAns = vbNo Then Exit Sub
    
    With [Summary]
    
'       Specify which portfolio's graphics in summary sheet to include.
'       Do by setting print range in the Summary worksheet. Either graphics
'       for Portfolio 1 or for Portfolio 2. There is a name for both, from which
'       to get the range to print.
        sPrintAreaAddress = .Range("Print_Area_Portfolio" & plPortfolioNum).Address

Debug.Print "sPrintAreaAddress = " & sPrintAreaAddress

        .PageSetup.PrintArea = sPrintAreaAddress
        
Debug.Print ".PageSetup.PrintArea = " & .PageSetup.PrintArea

    End With

'   Select the Summary and Portfolio worksheets from which to create the PDF.
    Sheets(Array(sSummarySheetName, sPortfolioSheetName)).Select
    
'   Activate the Summary worksheet.
    Sheets(sSummarySheetName).Activate
    
    On Error GoTo ErrHandler
    
    Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=sFileSpec, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
 
'       Put user into the sheet that was active before.
        wsActive.Select

Closeout:

Exit Sub

ErrHandler:

    sMsg = "Cannot create file " & sFileName & "." _
         & Chr(10) & "Make sure that the file is not open."
    
    vAns = MsgBox(sMsg, vbCritical, "Save PDF of Portfolio Data")
    
    wsActive.Select

End Sub

Here are Debug.Print statements' output. All values are correct.

plPortfolioNum = 1
sSummarySheetName = Summary
sPortfolioSheetName = Taxable
sFileName = 02-15-23_Taxable.pdf
sPath = C:\Users\Jim\Desktop\Investments\
Summary sheet sPrintAreaAddress = $A$2:$N$39
Summary sheet .PageSetup.PrintArea = $A$2:$N$39
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Should probably "activesheet.ExportAsFixedFormat," not "selection" selection is a range
 
Upvote 0
Solution

Forum statistics

Threads
1,214,947
Messages
6,122,413
Members
449,082
Latest member
tish101

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top