PrintToExcelAndPDF file

[jagadeesh.rt]

Option Explicit
Sub PrintToExcelAndPDF()

'Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim sSheetsToPrint As String
Dim sSheets() As String
Dim lSheet As Long
Dim lTtlSheets As Long
Dim bRestart As Boolean
Dim rowCtr As Integer
Dim pcp_name As String
Dim maxRow As Integer
Dim pivotFile As String
Dim templateFile As String
Dim LastRow As Integer
Dim LastCol As Integer
Dim dirPath As String
Dim atRisk As String

'/// Record the sheets you want to print here! ///
'/// Use sheet names separated by commas only ///
sSheetsToPrint = "ERS"

' SET source file and destination file names
pivotFile = "DATA ER template.xlsx"
templateFile = "Medicaid Census Template - COPY.xlsx"

'***********Start Logic***********

Sheets("LIST").Select
With ActiveSheet
maxRow = .Range("A4").End(xlDown).Row
End With

MsgBox maxRow & ""

For rowCtr = 5 To 8
'Select PCP from the List
Sheets("LIST").Select
pcp_Group = ActiveSheet.Range("A" & rowCtr).Value


sPDFName = Group
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

'Set Slicers to pcp_name

ActiveWorkbook.SlicerCaches("Slicer_GROUP").VisibleSlicerItemsList = Array("[group].[GROUP].&[" & _
pcp_Group & "]")





'OPEN REPORT TEMPLATE
Application.Workbooks.Open (sPDFPath & templateFile)
Windows(templateFile).Activate

'DELETE SFR SHEET FOR ALL PCPS. TBD CHECK IF PCP IS AT RISK, THEN COPY SFR DATA
Application.DisplayAlerts = False
'Sheets("SFR").Delete
Application.DisplayAlerts = True

'DELETE SFR ROW FROM LIST OF REPORTS FOR NON AT RISK PCPS
'Sheets("LIST OF REPORTS").Select
'If atRisk <> "1" Then
'Rows("2:2").Select
'Selection.Delete Shift:=xlUp
'End If


'COPY all reports from Pivot Tables to Report Template

'Split the sheets into an array
sSheets() = Split(sSheetsToPrint, ",")

lTtlSheets = 0

'ITERATE OVER ALL SHEETS
For lSheet = LBound(sSheets) To UBound(sSheets)

'SWITCH to PowerPivot
ThisWorkbook.Activate

If Not IsEmpty(Application.Sheets(sSheets(lSheet)).UsedRange) Then

Sheets(sSheets(lSheet)).Select
Range("b12").Select

'MsgBox ActiveCell.Value

If IsEmpty(ActiveCell.Value) Then
Application.DisplayAlerts = False
Windows(templateFile).Activate
Sheets(sSheets(lSheet)).Delete
Application.DisplayAlerts = True
lTtlSheets = lTtlSheets + 1

Else
'FIND LAST ROW ON DATA SHEET

With ActiveSheet
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row '.Range("A12").SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column '.Range("A12").SpecialCells(xlCellTypeLastCell).Column
End With


lTtlSheets = lTtlSheets + 1

'COPY CELLS
Range(Cells(12, 2), Cells(LastRow, LastCol)).Select
Selection.Copy

'=============================================

'PASTE in the Template
Windows(templateFile).Activate
Sheets(sSheets(lSheet)).Select
Range("B4").Select
ActiveSheet.Paste

'FILL SERIES in Column A
'Range("A2").Select
'ActiveCell.FormulaR1C1 = "1"
'Selection.AutoFill Destination:=Range("A2:A" & LastRow - 10), Type:=xlFillSeries


'FORMAT copies cells
Range(Cells(4, 1), Cells(LastRow - 8, LastCol)).Select
With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With

'FORMAT_TEMPLATE_CELLS

Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Range("A1").Select

' SET HEADER
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial Narrow,Bold""COMPLEX CARE MANAGEMENT REPORT - " & pcp_name & .LeftHeader
.LeftFooter = "&""Arial Narrow""FOR: " & UCase(Format(Now, "MMM YYYY"))
End With

' SET Print Area
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(LastRow - 8, LastCol)).Address
lTtlSheets = lTtlSheets + 1
End If

End If
Next lSheet


'SWITCH to PowerPivot
Windows(templateFile).Activate

'MsgBox sPDFPath & sPDFName & ".xlsx"

'===========================================================================

MkDir sPDFPath & pcp_name
dirPath = sPDFPath & pcp_name & Application.PathSeparator

'PRINT PCP Name.xlsx TO PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
dirPath & pcp_name & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False


'SAVE PCP Name.xlsx and close it
'SAVE Report Template as PCP Name.xlsx
ActiveWorkbook.SaveAs Filename:=dirPath & sPDFName & ".xlsx"
ActiveWorkbook.Save
ActiveWindow.Close

Next
'***********End Logic***********

Cleanup:
'Release objects and terminate PDFCreator
' Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered. PDFCreator has" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup

End Sub

[Keebellah]

How about reading the forum rules and how to embed code tags?
And what's this all about anyway?