VBA to print to PDF based on drop-down using ExportAsFixedFormat has quality issues... fixes?

[MikeDolanFliss]

Hi there, big and longtime fan.

I've got a project where I'm printing dashboard reports for every county in a state. I'd like to dump PDFs for every element in the dropdown - and that dropdown controls dozens of graphs and text in about 10 pages of reports (in the below example I'm just printing page 4 of the report). I've seen a number of elegant solutions using ExportAsFixedFormat. Unfortunately, the quality of that PDF report (images, colored text, etc.) is noticable..janky. The Adobe PDF printer does a much better job... but I can't seem to get the printout command to print anything recognizable as PDF (though I can get files outputed, I couldn't tell you what format they are.

The issues seems to be with camera tool and images, at least. Attached is a side-by-side of what I'm talking about.

https://www.dropbox.com/s/ymwfmje4lk5gj8q/excelprintPDFexample.png?dl=0

Any thoughts, Excel genuiuses?

Sub Macro1()
'
' Macro1 Macro
'
Dim ws As Worksheet
Dim ws_unique As Worksheet
Dim UniqueRng As Range
Dim Cell As Range
Dim DropDown As Range

Application.ScreenUpdating = False

'added so it works across workbooks from a pure "printer" workbook.
Windows("CountyHealthData.xlsx").Activate
'Currently unused...
'DirectoryLocation = ActiveWorkbook.Path

Set ws = Worksheets("Reports") 'Amend to reflect the sheet you wish to work with
Set ws_unique = Worksheets("CT plans") 'Amend to reflect the sheet you wish to work with
Set DropDown = ws.Range("B25")

With ws
Set UniqueRng = ws_unique.Range("F3:F5") 'to F38
For Each Cell In UniqueRng
DropDown.Value = Cell.Value
Name = "E:\Dropbox\Community\CounterTools-Mike Collab\draft reports\" & "DashboardDraft8_" & Cell.Value & ".PDF"
'ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name _
' , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
' :=False, OpenAfterPublish:=False, From:=4, To:=4

' Prints files, but unrecognizable as PDFs. "Can't open because it's been damaged..." error.
ws.PrintOut IgnorePrintAreas:=False, _
From:=4, To:=4, _
ActivePrinter:="Adobe PDF:", _
PrintToFile:=True, PrToFileName:=Name
Next Cell
End With

Application.ScreenUpdating = True
End Sub