Sub Save_as_PDF()
Dim Cnt As Integer
Dim Comp As Boolean
Dim CompSkaters As Integer
Dim EventCost As Integer
Dim Mileage As Integer
Dim CostPerKM As Single
Dim Food As Single
Dim Hotel As Single
Dim LateFee As Integer
EventCost = 20
CostPerKM = 0.48
LateFee = 20
Dim OutlookApp As Object
Dim OutlookMail As Object
If Worksheets(1).Range("F26") <> 0 Or Worksheets(1).Range("F27") <> 0 Or Worksheets(1).Range("F28") <> 0 Then 'checks if there is a competition and how many skaters went
Comp = True
Cnt = 1
Do While Worksheets(1).Cells(3, Cnt * 4 - 2) <> ""
If Worksheets(1).Cells(21, Cnt * 4 - 2) <> 0 Then
CompSkaters = CompSkaters + 1
End If
Cnt = Cnt + 1
Loop
Mileage = Worksheets(1).Range("F26")
Hotel = Worksheets(1).Range("F27")
Food = Worksheets(1).Range("F28")
Else
Comp = False
End If
For Cnt = 3 To Worksheets.Count
If Worksheets(Cnt).Range("E28") <> 0 Or Worksheets(1).Cells(21, Cnt * 4 - 10) <> 0 Or Worksheets(1).Cells(19, Cnt * 4 - 10) <> 0 Then 'if the owe something
If Worksheets(1).Cells(19, Cnt * 4 - 10) <> 0 Then 'adds past due and late fees to invoice
Worksheets(Cnt).Cells(28, 3) = "Current Bill"
Worksheets(Cnt).Cells(29, 3) = "Past Due"
Worksheets(Cnt).Cells(29, 3).Font.Bold = True
Worksheets(Cnt).Cells(29, 5) = Worksheets(1).Cells(19, Cnt * 4 - 10)
Worksheets(Cnt).Cells(29, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(29, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(29, 5).Font.Bold = True
Worksheets(Cnt).Cells(30, 3) = "Late Charge"
Worksheets(Cnt).Cells(30, 3).Font.Bold = True
Worksheets(Cnt).Cells(30, 5) = LateFee
Worksheets(Cnt).Cells(30, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(30, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(30, 5).Font.Bold = True
Worksheets(Cnt).Cells(31, 3) = "Total"
Worksheets(Cnt).Cells(31, 3).Font.Bold = True
Worksheets(Cnt).Cells(31, 5) = Worksheets(Cnt).Cells(29, 5) + Worksheets(Cnt).Cells(28, 5) + Worksheets(Cnt).Cells(30, 5)
Worksheets(Cnt).Cells(31, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(31, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(31, 5).Font.Bold = True
End If
If Comp = True And Worksheets(1).Cells(21, Cnt * 4 - 10) <> 0 Then 'adds competition to individual invoices
If Worksheets(Cnt).Cells(31, 5) <> 0 Then
Worksheets(Cnt).Cells(31, 3) = "Sub-Total"
Else
Worksheets(Cnt).Cells(28, 3) = "Sub-Total"
End If
Worksheets(Cnt).Cells(33, 3) = Worksheets(1).Cells(21, Cnt * 4 - 10) & " Event(s)"
Worksheets(Cnt).Cells(33, 5) = EventCost * Worksheets(1).Cells(21, Cnt * 4 - 10)
Worksheets(Cnt).Cells(33, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(33, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(34, 3) = "Mileage: " & Mileage & " km"
Worksheets(Cnt).Cells(34, 5) = Mileage * CostPerKM / CompSkaters
Worksheets(Cnt).Cells(34, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(34, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(35, 3) = "Hotel"
Worksheets(Cnt).Cells(35, 5) = Hotel / CompSkaters
Worksheets(Cnt).Cells(35, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(35, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(36, 3) = "Food"
Worksheets(Cnt).Cells(36, 5) = Food / CompSkaters
Worksheets(Cnt).Cells(36, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(36, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(37, 3) = "Competition Total"
Worksheets(Cnt).Cells(37, 3).Font.Bold = True
Worksheets(Cnt).Cells(37, 5) = (Food + Hotel + Mileage * CostPerKM) / CompSkaters + EventCost * Worksheets(1).Cells(21, Cnt * 4 - 10)
Worksheets(Cnt).Cells(37, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(37, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(37, 5).Font.Bold = True
Worksheets(Cnt).Cells(39, 3) = "Total"
Worksheets(Cnt).Cells(39, 3).Font.Bold = True
If Worksheets(Cnt).Cells(31, 5) <> 0 Then
Worksheets(Cnt).Cells(39, 5) = Worksheets(Cnt).Cells(31, 5) + Worksheets(Cnt).Cells(37, 5)
Else
Worksheets(Cnt).Cells(39, 5) = Worksheets(Cnt).Cells(28, 5) + Worksheets(Cnt).Cells(37, 5)
End If
Worksheets(Cnt).Cells(39, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(39, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(39, 5).Font.Bold = True
End If
With Worksheets(Cnt).PageSetup 'creates PDFs
.CenterHeader = ""
.Orientation = xlPortrait
.PrintArea = "$A$1:$E$49"
.PrintTitleRows = ActiveSheet.Rows(5).Address
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
End With
Worksheets(Cnt).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Carly and Steve\Documents\Carly skating\Invoices\Invoices Exported by Spreadsheet" & Worksheets(Cnt).Name & " " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
From:=1, _
To:=5, _
OpenAfterPublish:=False
Set OutlookApp = CreateObject("Outlook.Application") 'emails PDFs
If Worksheets(1).Cells(20, Cnt * 4 - 10) <> "" Then
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = Worksheets(1).Cells(20, Cnt * 4 - 10)
.Subject = "Invoice for Figure Skating Lessons from " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd")
.BodyFormat = 2
.HTMLBody = "Please find attached your invoice for " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd") & "<BR>Please pay by " & Format(DateAdd("ww", 2, Date), "yyyy-mm-dd") & " to avoid late fees.<BR>Let me know if you have any problems.<BR><BR>Thanks,<BR>Carly Dinicol"
.Attachments.Add "C:\Users\Carly and Steve\Documents\Carly skating\Invoices\Invoices Exported by Spreadsheet" & Worksheets(Cnt).Name & " " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd") & ".pdf"
.Display
End With
End If
End If
Worksheets(2).Cells(Cnt, 1) = Worksheets(Cnt).Name 'creates ledger
Worksheets(2).Cells(Cnt, 2) = Worksheets(1).Cells(19, Cnt * 4 - 10)
If Worksheets(Cnt).Range("E37") = 0 Then
Worksheets(2).Cells(Cnt, 3) = Worksheets(Cnt).Range("E28")
Else
Worksheets(2).Cells(Cnt, 3) = Worksheets(Cnt).Range("E28") + Worksheets(Cnt).Range("E37")
End If
If Worksheets(2).Cells(Cnt, 2) = 0 Then
Worksheets(2).Cells(Cnt, 4) = Worksheets(2).Cells(Cnt, 3)
Else
Worksheets(2).Cells(Cnt, 4) = Worksheets(2).Cells(Cnt, 2) + Worksheets(2).Cells(Cnt, 3) + LateFee
End If
If Worksheets(2).Cells(Cnt, 4) <> 0 Then
Worksheets(2).Cells(Cnt, 6) = Format(Date, "yyyy-mm-dd")
Else
Worksheets(2).Cells(Cnt, 6) = ""
End If
Next
With Worksheets(2).PageSetup 'saves ledger
.CenterHeader = ""
.Orientation = xlPortrait
.PrintArea = "$A$1:$G$49"
.PrintTitleRows = ActiveSheet.Rows(5).Address
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
End With
Worksheets(2).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Carly and Steve\Documents\Carly skating\Invoices\Invoices Exported by Spreadsheet" & "Skater Balances " & Format(Date, "yyyy-mm-dd"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
From:=1, _
To:=5, _
OpenAfterPublish:=False
Set OutlookMail = Nothing
Set OutlookApp = Nothing
MsgBox "PDFs created and emails sent. Love you babe!"
End Sub