HTML Code:
Sub format_sheets_now()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim Excel_Application As Excel.Application
Dim Excel_Workbook As Workbook
Dim gg As String
gg = "C:\aaa\timesheets\Employee Time Report master.xls"
Set Excel_Workbook = Workbooks.Open(gg)
Set Excel_Application = Excel_Workbook.Parent
Excel_Application.Visible = True
Excel_Workbook.Worksheets(1).Select
Excel_Application.DisplayAlerts = False
sdt = Format(start_date, "dd-mm-yy")
edt = Format(End_date, "dd-mm-yy")
Excel_Workbook.SaveAs filename:="C:\aaa\timesheets\Employee Time Report for - " & sdt & " to " & edt & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Excel_Application.DisplayAlerts = True
'add print preview macro
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = Excel_Workbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
Dim CodeMod As VBIDE.CodeModule
Dim CodeMod1 As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """"
VBComp.Name = "preview"
Set VBComp = VBProj.VBComponents("preview")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Sub print_preview"
LineNum = LineNum + 1
.InsertLines LineNum, "ActiveWorkbook.Worksheets.PrintPreview"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
LineNum = LineNum + 1
.InsertLines LineNum, "Sub Send_Mail"
LineNum = LineNum + 1
.InsertLines LineNum, "Dim OutlookApp As Object"
LineNum = LineNum + 1
.InsertLines LineNum, "Dim OutlookMail As Object"
LineNum = LineNum + 1
.InsertLines LineNum, "Set OutlookApp = CreateObject(" & DQUOTE & "Outlook.Application" & DQUOTE & ")"
LineNum = LineNum + 1
.InsertLines LineNum, "Set OutlookMail = OutlookApp.CreateItem(0)"
LineNum = LineNum + 1
.InsertLines LineNum, "t = ThisWorkbook.FullName"
LineNum = LineNum + 1
.InsertLines LineNum, "With OutlookMail"
LineNum = LineNum + 1
.InsertLines LineNum, "Application.DisplayAlerts = False"
LineNum = LineNum + 1
.InsertLines LineNum, "ActiveWorkbook.Save"
LineNum = LineNum + 1
.InsertLines LineNum, "Application.DisplayAlerts = True"
LineNum = LineNum + 1
.InsertLines LineNum, ".Attachments.Add(t)"
LineNum = LineNum + 1
.InsertLines LineNum, ".Subject = " & DQUOTE & "Employee Time Sheets" & DQUOTE
LineNum = LineNum + 1
.InsertLines LineNum, ".Display"
LineNum = LineNum + 1
.InsertLines LineNum, "End With"
LineNum = LineNum + 1
.InsertLines LineNum, "Set OutlookMail = Nothing"
LineNum = LineNum + 1
.InsertLines LineNum, "Set OutlookApp = Nothing"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
Excel_Workbook.Worksheets(1).Select
Excel_Workbook.Worksheets.Add ' Summary
Excel_Workbook.Worksheets(1).Name = "Summary"
'main sheet formatting here
Excel_Application.DisplayFormulaBar = False
Excel_Application.ActiveWindow.DisplayGridlines = False
Excel_Application.ActiveWindow.DisplayHeadings = False
For sheet_count = 2 To Excel_Workbook.Worksheets.Count
Set Current_Worksheet = Excel_Workbook.Worksheets(sheet_count)
Excel_Workbook.Worksheets(sheet_count).Select
Current_Worksheet.Cells.Select
With Selection
Current_Worksheet.Cells.HorizontalAlignment = xlRight
Current_Worksheet.Cells.Font.Name = "Times New Roman"
End With
Current_Worksheet.Range("A1:P1").HorizontalAlignment = xlCenter
Current_Worksheet.Range("A1:P1").VerticalAlignment = xlCenter
Current_Worksheet.Range("A1:P1").Font.Bold = True
Current_Worksheet.Range("C:F").NumberFormat = "h:mm"
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
rng1 = "A$2:P" & Mid(last_cell, 4, 3)
' SORT BY NAME IN THEN DATE IN
Current_Worksheet.Range(rng1).Sort Key1:=Current_Worksheet.Range("A8"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
last_row = Mid(last_cell, 4, 3)
st_date = Me.start_date
en_date = Me.End_date
date_count = en_date - st_date
Current_Worksheet.Range("A2").Select
If IsEmpty(Current_Worksheet.Range("A2").Value) Then
Current_Worksheet.Range("A2").Value = st_date
Else
End If
try_again1:
If Current_Worksheet.Range("A2").Value > st_date Then
Current_Worksheet.Rows("2:2").Insert Shift:=xlDown
Current_Worksheet.Range("A2").Value = Current_Worksheet.Range("A3").Value - 1
GoTo try_again1
Else
End If
For ib = 2 To 50 'date_count + 2
nxt_row:
cur_cell = Current_Worksheet.Range("A" & ib).Value
nxt_cell = Current_Worksheet.Range("A" & ib + 1).Value
If IsEmpty(nxt_cell) Then
GoTo done_it
Else
End If
If nxt_cell - 1 = cur_cell Then
ib = ib + 1
GoTo nxt_row
Else
Current_Worksheet.Rows(ib + 1 & ":" & ib + 1).Insert Shift:=xlDown
Current_Worksheet.Range("A" & ib + 1).Value = Current_Worksheet.Range("A" & ib).Value + 1
End If
Next ib
done_it:
try_again2:
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
If Current_Worksheet.Range("A" & Mid(last_cell, 4, 3)).Value < en_date Then
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1).Value = Current_Worksheet.Range("A" & Mid(last_cell, 4, 3)).Value + 1
GoTo try_again2
Else
End If
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1).Value = Current_Worksheet.Range("A" & Mid(last_cell, 4, 3)).Value + 1
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
For i = 2 To Mid(last_cell, 4, 3)
If Not IsEmpty(Current_Worksheet.Range("C" & i).Value) And Not IsEmpty(Current_Worksheet.Range("C" & i).Value) Then
If Me.Check103 = True Then
Current_Worksheet.Range("C" & i).Value = TimeValue(Me.Text105)
Else
End If
If Me.set_lunch = True Then
Current_Worksheet.Range("D" & i).Value = TimeValue(Me.Text120)
Else
End If
If Me.Check117 = True Then
Current_Worksheet.Range("E" & i).Value = TimeValue(Me.Text122)
Else
End If
If Me.Check113 = True Then
Current_Worksheet.Range("F" & i).Value = TimeValue(Me.Text107)
Else
End If
Else
End If
Next i
For i = 2 To Mid(last_cell, 4, 3)
If Mid(Current_Worksheet.Range("C" & i).Value, 3, 1) = ":" Then
Current_Worksheet.Range("C" & i) = TimeValue(Current_Worksheet.Range("C" & i))
Else
End If
Next i
For i = 2 To Mid(last_cell, 4, 3)
If Mid(Current_Worksheet.Range("F" & i).Value, 3, 1) = ":" Then
Current_Worksheet.Range("F" & i) = TimeValue(Current_Worksheet.Range("F" & i))
Else
End If
Next i
Current_Worksheet.Range("A$1:P" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.ListObjects.Add(xlSrcRange, , xlYes, xlYes).Name = "List1"
Current_Worksheet.ListObjects("List1").TableStyle = "TableStyleMedium10"
End With
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
Current_Worksheet.Range("A2:P" & Mid(last_cell, 4, 3)).Font.Size = 14
Current_Worksheet.Range("A2:P" & Mid(last_cell, 4, 3)).Font.Bold = False
Current_Worksheet.Range("A2:P" & Mid(last_cell, 4, 3)).HorizontalAlignment = xlLeft
Current_Worksheet.Range("B2:B" & Mid(last_cell, 4, 3)).HorizontalAlignment = xlRight
Current_Worksheet.Range("A:A").ColumnWidth = 10
Current_Worksheet.Range("B:B").ColumnWidth = 6
Current_Worksheet.Range("C:C").ColumnWidth = 9
Current_Worksheet.Range("D:D").ColumnWidth = 9
Current_Worksheet.Range("E:E").ColumnWidth = 9
Current_Worksheet.Range("F:F").ColumnWidth = 9
Current_Worksheet.Range("G:G").ColumnWidth = 2.5
Current_Worksheet.Range("H:H").ColumnWidth = 6.5
Current_Worksheet.Range("I:I").ColumnWidth = 7
Current_Worksheet.Range("J:J").ColumnWidth = 7.5
Current_Worksheet.Range("K:K").ColumnWidth = 10
Current_Worksheet.Range("L:L").ColumnWidth = 2
Current_Worksheet.Range("M:M").ColumnWidth = 9.5
Current_Worksheet.Range("N:N").ColumnWidth = 9.5
Current_Worksheet.Range("O:O").ColumnWidth = 9.5
Current_Worksheet.Range("P:P").ColumnWidth = 9.5
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 2 & ":P" & Mid(last_cell, 4, 3) + 2).NumberFormat = "0.00"
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2).Value = "Totals"
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2 & ":P" & Mid(last_cell, 4, 3) + 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2 & ":P" & Mid(last_cell, 4, 3) + 2).Font.Bold = True
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2 & ":L" & Mid(last_cell, 4, 3) + 2).Merge
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2 & ":L" & Mid(last_cell, 4, 3) + 2).HorizontalAlignment = xlCenter
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2 & ":P" & Mid(last_cell, 4, 3) + 2).Font.Size = 16
Current_Worksheet.Range("A2").Select
Current_Worksheet.Rows("1:1").Insert Shift:=xlDown
Current_Worksheet.Rows("1:1").Insert Shift:=xlDown
Current_Worksheet.Rows("1:1").Insert Shift:=xlDown
Current_Worksheet.Rows("1:1").Insert Shift:=xlDown
Current_Worksheet.Range("A1").Value = "Employee Time Sheet"
Current_Worksheet.Range("A1").Font.Color = -16777024
Current_Worksheet.Range("F1").Value = "First Name"
Current_Worksheet.Range("K1").Value = "Last Name"
Current_Worksheet.Range("O1").Value = "Code #"
Current_Worksheet.Range("G2").Value = "Employment Type"
Current_Worksheet.Range("L2").Value = "Normal Hours"
Dim myNum As Long
myNum = 0
If Left(Current_Worksheet.Name, 9) = "Firstname" Then 'fix sheet names
Current_Worksheet.Range("Q1").Value = Excel_Workbook.Worksheets(sheet_count).Name
Current_Worksheet.Range("R1").Formula = "=Left(Q1, (Find(""_"", Q1) - 1))"
Current_Worksheet.Range("S1").Formula = "=Len(Left(Q1,(Find(""_"", Q1))+1))"
Current_Worksheet.Range("T1").Formula = "=MID(Q1,S1,100)"
Current_Worksheet.Range("G1").Value = Current_Worksheet.Range("R1").Value
Current_Worksheet.Range("L1").Value = Current_Worksheet.Range("T1").Value
Current_Worksheet.Range("Q1").Value = ""
Current_Worksheet.Range("R1").Value = ""
Current_Worksheet.Range("S1").Value = ""
Current_Worksheet.Range("T1").Value = ""
Else
For i = 1 To Len(Excel_Workbook.Worksheets(sheet_count).Name)
If IsNumeric(Mid(Excel_Workbook.Worksheets(sheet_count).Name, i, 1)) = True Then
myNum = myNum & Mid(Excel_Workbook.Worksheets(sheet_count).Name, i, 1)
End If
Next i
Current_Worksheet.Range("G1").Value = DLookup("[First Name]", "Employees", "[Code #]= " & myNum)
Current_Worksheet.Range("L1").Value = DLookup("[Last Name]", "Employees", "[Code #]= " & myNum)
Current_Worksheet.Range("P1").Value = DLookup("[Code #]", "Employees", "[Code #]= " & myNum)
Current_Worksheet.Range("J2").Value = DLookup("[Employment Type]", "Employees", "[Code #]= " & myNum)
tt2 = Format(DLookup("[Normal Start Time]", "Employees", "[Code #]= " & myNum), "H:MM" + "am/pm")
tt3 = Format(DLookup("[Normal End Time]", "Employees", "[Code #]= " & myNum), "H:MM" + "am/pm")
Current_Worksheet.Range("N2").Value = tt2 & " to " & tt3
End If
Current_Worksheet.Range("A1:E1").MergeCells = True
Current_Worksheet.Range("G1:J1").MergeCells = True
Current_Worksheet.Range("K1").HorizontalAlignment = xlRight
Current_Worksheet.Range("L1:N1").MergeCells = True
Current_Worksheet.Range("A1").Cells.HorizontalAlignment = xlCenter
Current_Worksheet.Range("G1").Cells.HorizontalAlignment = xlLeft
Current_Worksheet.Range("M1").Cells.HorizontalAlignment = xlLeft
Current_Worksheet.Range("P1").Cells.HorizontalAlignment = xlLeft
Current_Worksheet.Range("G2:P2").Cells.HorizontalAlignment = xlLeft
Current_Worksheet.Range("A1").Font.Bold = True
Current_Worksheet.Range("G1").Font.Bold = True
Current_Worksheet.Range("L1").Font.Bold = True
Current_Worksheet.Range("P1").Font.Bold = True
Current_Worksheet.Range("A1").Font.Size = 16
Current_Worksheet.Range("G1").Font.Size = 16
Current_Worksheet.Range("L1").Font.Size = 16
Current_Worksheet.Range("P1").Font.Size = 16
Current_Worksheet.Range("J2").Font.Bold = True
Current_Worksheet.Range("N2").Font.Bold = True
Current_Worksheet.Range("J2").Font.Size = 16
Current_Worksheet.Range("N2").Font.Size = 16
Current_Worksheet.Range("A1:P1").Font.Name = "Times New Roman"
Current_Worksheet.Range("A1:P1").Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("A5:P5").WrapText = True
Current_Worksheet.Range("5:5").RowHeight = 31.5
Current_Worksheet.Range("5:5").VerticalAlignment = xlBottom
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
Current_Worksheet.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("H5:K5").Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("M5:P5").Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("A$5:F" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeRight).LineStyle = xlContinuous
Current_Worksheet.Range("A$5:F" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeTop).LineStyle = xlContinuous
Current_Worksheet.Range("A$5:F" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("A$5:F" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
Current_Worksheet.Range("A$6:F" & Mid(last_cell, 4, 3) - 2).Borders(xlInsideVertical).Weight = xlHairline
Current_Worksheet.Range("A$6:F" & Mid(last_cell, 4, 3) - 2).Borders(xlInsideHorizontal).Weight = xlHairline
Current_Worksheet.Range("H$5:K" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeRight).LineStyle = xlContinuous
Current_Worksheet.Range("H$5:K" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeTop).LineStyle = xlContinuous
Current_Worksheet.Range("H$5:K" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("H$5:K" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
Current_Worksheet.Range("H$6:K" & Mid(last_cell, 4, 3) - 2).Borders(xlInsideVertical).Weight = xlHairline
Current_Worksheet.Range("H$6:K" & Mid(last_cell, 4, 3) - 2).Borders(xlInsideHorizontal).Weight = xlHairline
Current_Worksheet.Range("M$5:P" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeRight).LineStyle = xlContinuous
Current_Worksheet.Range("M$5:P" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeTop).LineStyle = xlContinuous
Current_Worksheet.Range("M$5:P" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Current_Worksheet.Range("M$5:P" & Mid(last_cell, 4, 3) - 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
Current_Worksheet.Range("M$6:P" & Mid(last_cell, 4, 3) - 2).Borders(xlInsideVertical).Weight = xlHairline
Current_Worksheet.Range("M$6:P" & Mid(last_cell, 4, 3) - 2).Borders(xlInsideHorizontal).Weight = xlHairline
Current_Worksheet.Range("G$5:G" & Mid(last_cell, 4, 3) - 2).Interior.Color = 16777215
Current_Worksheet.Range("L$5:L" & Mid(last_cell, 4, 3) - 2).Interior.Color = 16777215
Current_Worksheet.Range("G$5:G" & Mid(last_cell, 4, 3) - 2).Font.Color = 16777215
Current_Worksheet.Range("L$5:L" & Mid(last_cell, 4, 3) - 2).Font.Color = 16777215
Current_Worksheet.Range("L$5:L" & Mid(last_cell, 4, 3) - 2).Font.Size = 1
Current_Worksheet.Rows("4:4").Insert Shift:=xlDown
Current_Worksheet.Rows("4:4").Insert Shift:=xlDown
Current_Worksheet.Range("H4:O4").Font.Name = "Times New Roman"
Current_Worksheet.Range("H4:O4").Borders(xlEdgeBottom).Weight = xlHairline
Current_Worksheet.Range("H4:I4").MergeCells = True
Current_Worksheet.Range("H4:I4").Value = "Pay Period"
Current_Worksheet.Range("H4:I4").Font.Size = 14
Current_Worksheet.Range("H4:I4").MergeCells = True
Current_Worksheet.Range("J4").Value = Format(Forms![main menu]![start_date], "d mmm, yyyy")
Current_Worksheet.Range("J4:L4").HorizontalAlignment = xlRight
Current_Worksheet.Range("J4:L4").MergeCells = True
Current_Worksheet.Range("J4:L4").Font.Size = 16
Current_Worksheet.Range("J4:L4").Font.Bold = True
Current_Worksheet.Range("M4").Value = "to"
Current_Worksheet.Range("M4:M4").HorizontalAlignment = xlCenter
Current_Worksheet.Range("N4").Value = Format(Forms![main menu]![End_date], "d mmm, yyyy")
Current_Worksheet.Range("N4:O4").MergeCells = True
Current_Worksheet.Range("N4:O4").HorizontalAlignment = xlLeft
Current_Worksheet.Range("N4:O4").Font.Bold = True
Current_Worksheet.Range("N4:O4").Font.Size = 16
Current_Worksheet.Range("A6:P6").Font.Size = 14
Current_Worksheet.Range("A7:P7").Font.Size = 10
Current_Worksheet.Range("A8:P" & Mid(last_cell, 4, 3)).Font.Size = 12
' set list row titles
With Current_Worksheet
.Range("B7").Value = "Lunch" & vbLf & "Day"
.Range("C7").Value = "Lunch" & vbLf & "IN"
.Range("D7").Value = "Lunch" & vbLf & "Start"
.Range("E7").Value = "Lunch" & vbLf & "End"
.Range("F7").Value = "OUT"
.Range("H7").Value = "Time @ Lunch"
.Range("I7").Value = "Hours Worked"
.Range("J7").Value = "Miniutes worked"
.Range("K7").Value = "Paid Hours Worked"
.Range("M7").Value = "Normal Hours"
.Range("N7").Value = "Time and" & vbLf & "a Half"
.Range("O7").Value = "Double Time"
.Range("P7").Value = "Total" & vbLf & "Hours"
.Range("A6").Value = "TimeTracK Data"
.Range("A6:F6").MergeCells = True
.Range("A6:F6").HorizontalAlignment = xlCenter
.Range("H6").Value = "Calculated Times"
.Range("H6:K6").MergeCells = True
.Range("H6:K6").HorizontalAlignment = xlCenter
.Range("M6").Value = "Payroll Offce Use"
.Range("M6:P6").MergeCells = True
.Range("M6:P6").HorizontalAlignment = xlCenter
End With
'' sums go here
Current_Worksheet.Range("N8:N" & Mid(last_cell, 4, 3)).Value = ""
Current_Worksheet.Range("B8:B" & Mid(last_cell, 4, 3)).Formula = "=IF(ISBLANK($A8)," & Chr(34) & "" & Chr(34) & ",$A8)"
Current_Worksheet.Range("G8:G" & Mid(last_cell, 4, 3)).Formula = "=IF(AND(ISBLANK(C8),ISBLANK(D8),ISBLANK(E8),ISBLANK(F8)),5, IF(OR(ISBLANK(A8),ISBLANK(C8),ISBLANK(D8),ISBLANK(E8),ISBLANK(F8),MOD(MINUTE(C8),15)>0,MOD(MINUTE(D8),15)>0,MOD(MINUTE(E8),15)>0,MOD(MINUTE(F8),15)>0,(H8)<=0,(C8)>(D8),(D8)>(E8),(E8)>(F8),ISERROR(H8),ISERROR(I9),ISERROR(O8),ISERROR(P8)),1, IF(OR((C8)<0.270833333,(C8)>0.770833334),1, IF(OR((D8)<0.270833333,(D8)>0.770833334),1, IF(OR((E8)<0.270833333,(E8)>0.770833334),1, IF(OR((F8)<0.270833333,(F8)>0.770833334),1,10))))))"
Current_Worksheet.Range("H8:H" & Mid(last_cell, 4, 3)).Formula = "=($E8-$D8)"
Current_Worksheet.Range("I8:I" & Mid(last_cell, 4, 3)).Formula = "=HOUR($K8)/24"
Current_Worksheet.Range("J8:J" & Mid(last_cell, 4, 3)).Formula = "=$K8-HOUR($K8)/24"
Current_Worksheet.Range("K8:K" & Mid(last_cell, 4, 3)).Formula = "=IF(AND((C8)<(D8),(D8)<(E8),(E8)<(F8),(F8)>(E8)),($F8-$C8)-($E8-$D8),0)"
Current_Worksheet.Range("M8").Formula = "=IF(OR(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sat" & Chr(34) & ", TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sun" & Chr(34) & "), 0, IF($K8*24 > 8, 8, ($K8*24)))"
Current_Worksheet.Range("N8").Formula = "=IF(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sun" & Chr(34) & ",0,IF(AND(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sat" & Chr(34) & ",$K8*24>4),4,IF(AND(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sat" & Chr(34) & ",$K8*24<=4),$K8*24,IF(AND(NOT(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sat" & Chr(34) & "),NOT(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sun" & Chr(34) & ")),IF(AND($K8*24>8, $K8*24<=11), (($K8*24)-8),IF($K8*24>=11, 3,IF($K8*24<=8,$K8-$K8)))))))"
Current_Worksheet.Range("O8").Formula = "=IF(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sun" & Chr(34) & ",$K8*24,IF(AND(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sat" & Chr(34) & ",($K8*24)-4<=0),0,IF(AND(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sat" & Chr(34) & ",(($K8*24)-4)>0),(($K8*24)-4),IF(AND(NOT(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sat" & Chr(34) & "),NOT(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sun" & Chr(34) & "),$K8*24>=11),(($K8*24)-11),0))))"
Current_Worksheet.Range("P8").Formula = "=($O8)+($N8)+($M8)"
Current_Worksheet.Range("$M" & Mid(last_cell, 4, 3) + 2).Formula = "=SUMIF($G$8:$G$" & Mid(last_cell, 4, 3) & "," & Chr(34) & ">1" & Chr(34) & ",$M$8:$M$" & Mid(last_cell, 4, 3) & ")"
Current_Worksheet.Range("$N" & Mid(last_cell, 4, 3) + 2).Formula = "=SUMIF($G$8:$G$" & Mid(last_cell, 4, 3) & "," & Chr(34) & ">1" & Chr(34) & ",$N$8:$N$" & Mid(last_cell, 4, 3) & ")"
Current_Worksheet.Range("$O" & Mid(last_cell, 4, 3) + 2).Formula = "=SUMIF($G$8:$G$" & Mid(last_cell, 4, 3) & "," & Chr(34) & ">1" & Chr(34) & ",$O$8:$O$" & Mid(last_cell, 4, 3) & ")"
Current_Worksheet.Range("$P" & Mid(last_cell, 4, 3) + 2).Formula = "=SUMIF($G$8:$G$" & Mid(last_cell, 4, 3) & "," & Chr(34) & ">1" & Chr(34) & ",$P$8:$P$" & Mid(last_cell, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("A" & 6 + sheet_count).Formula = "=" & Excel_Workbook.Worksheets(sheet_count).Name & "!P1"
a = Excel_Workbook.Worksheets(sheet_count).Name & "!L1 & " & """, """ & " & "
b = Excel_Workbook.Worksheets(sheet_count).Name & "!G1"
Excel_Workbook.Worksheets("Summary").Range("B" & 6 + sheet_count).Formula = "=" & a & b
Excel_Workbook.Worksheets("Summary").Range("C" & 6 + sheet_count).Formula = "=" & Excel_Workbook.Worksheets(sheet_count).Name & "!J2"
Excel_Workbook.Worksheets("Summary").Range("D" & 6 + sheet_count).Formula = "=" & Excel_Workbook.Worksheets(sheet_count).Name & "!M" & Mid(last_cell, 4, 3) + 2
Excel_Workbook.Worksheets("Summary").Range("G" & 6 + sheet_count).Formula = "=" & Excel_Workbook.Worksheets(sheet_count).Name & "!N" & Mid(last_cell, 4, 3) + 2
Excel_Workbook.Worksheets("Summary").Range("H" & 6 + sheet_count).Formula = "=" & Excel_Workbook.Worksheets(sheet_count).Name & "!O" & Mid(last_cell, 4, 3) + 2
Excel_Workbook.Worksheets("Summary").Range("J" & 6 + sheet_count).Formula = "=SUM($D" & 6 + sheet_count & ":$I" & 6 + sheet_count & ")"
Current_Worksheet.Range("I:I").NumberFormat = "[h]"
Current_Worksheet.Range("J:J").NumberFormat = "[m]"
Current_Worksheet.Range("K:K").NumberFormat = "[h]:mm"
Current_Worksheet.Range("M8:P" & Mid(last_cell, 4, 3)).NumberFormat = "0.00"
Current_Worksheet.Range("H8:P" & Mid(last_cell, 4, 3)).HorizontalAlignment = xlRight
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1 & ":F" & Mid(last_cell, 4, 3) + 1).MergeCells = True
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1).Value = "Amend the Times above as required, prior to submision"
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1).HorizontalAlignment = xlCenter
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1 & ":A" & Mid(last_cell, 4, 3) + 1).Font.Size = 10
Current_Worksheet.Range("A2:F5").MergeCells = True
Current_Worksheet.Range("A2").Value = " Enter times in 24 hour format. (7:00=7am 13:00=1pm)" & vbLf & "Only valid times between 6:30am and 6:30pm Accepted" & vbLf & "In multiples of 15 Minutes eg. (7:00, 7:15, 7:30, 7:45)"
Current_Worksheet.Range("A2").Characters(Start:=54, Length:=51).Font.Color = -16776961
Current_Worksheet.Range("A2").HorizontalAlignment = xlCenter
Current_Worksheet.Range("A2").VerticalAlignment = xlCenter
Current_Worksheet.Range("A2").WrapText = True
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 1 & ":P" & Mid(last_cell, 4, 3) + 1).RowHeight = 13.2
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 1 & ":K" & Mid(last_cell, 4, 3) + 1).MergeCells = True
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 1).Value = "Calculated cells have been protected"
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 1).HorizontalAlignment = xlCenter
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 1 & ":P" & Mid(last_cell, 4, 3) + 1).MergeCells = True
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 1).Value = "Results displayed in Decimal Time format"
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 1).HorizontalAlignment = xlCenter
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 1).Font.Size = 10
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 2).Font.Size = 16
' set conditional cell formats
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=ISblank(A8:F" & Mid(last_cell, 4, 3)
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).FormatConditions(1).Interior.Color = 255
End With
Current_Worksheet.Range("H8:K" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("H8:K" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=$G8<3"
Current_Worksheet.Range("H8:K" & Mid(last_cell, 4, 3)).FormatConditions(1).Interior.Color = 16777215
Current_Worksheet.Range("H8:K" & Mid(last_cell, 4, 3)).FormatConditions(1).Font.Color = 16777215
End With
Current_Worksheet.Range("M8:P" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("M8:P" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=$G8<3"
Current_Worksheet.Range("M8:P" & Mid(last_cell, 4, 3)).FormatConditions(1).Interior.Color = 16777215
Current_Worksheet.Range("M8:P" & Mid(last_cell, 4, 3)).FormatConditions(1).Font.Color = 16777215
End With
Set newiconset = Current_Worksheet.Range("G8:G" & Mid(last_cell, 4, 3)).FormatConditions.AddIconSetCondition
With Current_Worksheet.Range("G8:G" & Mid(last_cell, 4, 3)).FormatConditions(1).IconCriteria(2)
With Current_Worksheet.Range("G8:G" & Mid(last_cell, 4, 3)).FormatConditions(1)
' .ShowIconOnly = True
End With
.Type = xlConditionValueNumber
.Value = 1
.Operator = 7
.Icon = xlIconRedCross
End With
With Current_Worksheet.Range("G8:G" & Mid(last_cell, 4, 3)).FormatConditions(1).IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 3
.Operator = 5
.Icon = xlIconGreenCheck
End With
Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 9).Font.Color = 16777215
Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 9).Value = 10
Current_Worksheet.Range("L" & Mid(last_cell, 4, 3) + 9).Font.Color = 16777215
Current_Worksheet.Range("L" & Mid(last_cell, 4, 3) + 9).Value = 10
Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 10).Font.Color = 16777215
Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 10).Value = 10
Set newiconset2 = Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 10).FormatConditions.AddIconSetCondition
With Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 10).FormatConditions(1).IconCriteria(2)
With Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 10).FormatConditions(1)
.ShowIconOnly = True
End With
.Type = xlConditionValueNumber
.Value = 0
.Operator = 5
.Icon = xlIconRedCross
End With
With Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 10).FormatConditions(1).IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 1
.Operator = 7
.Icon = xlIconRedCross
End With
Set newiconset3 = Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 9).FormatConditions.AddIconSetCondition
With Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 9).FormatConditions(1).IconCriteria(2)
With Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 9).FormatConditions(1)
.ShowIconOnly = True
End With
.Type = xlConditionValueNumber
.Value = 0
.Operator = 5
.Icon = xlIconGreenCheck
End With
With Current_Worksheet.Range("G" & Mid(last_cell, 4, 3) + 9).FormatConditions(1).IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 1
.Operator = 7
.Icon = xlIconGreenCheck
End With
Set newiconset4 = Current_Worksheet.Range("L" & Mid(last_cell, 4, 3) + 9).FormatConditions.AddIconSetCondition
With Current_Worksheet.Range("L" & Mid(last_cell, 4, 3) + 9).FormatConditions(1).IconCriteria(2)
.Type = xlConditionValueNumber
.Value = 0
.Operator = 5
.Icon = xlIconYellowExclamation
End With
With Current_Worksheet.Range("L" & Mid(last_cell, 4, 3) + 9).FormatConditions(1).IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 1
.Operator = 7
.Icon = xlIconYellowExclamation
End With
Set newiconset5 = Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).FormatConditions.AddIconSetCondition
With Current_Worksheet.Range("C$8:F" & Mid(last_cell, 4, 3)).FormatConditions(2).IconCriteria(1)
.Icon = xlIconYellowExclamation
End With
With Current_Worksheet.Range("C$8:F" & Mid(last_cell, 4, 3)).FormatConditions(2).IconCriteria(2)
.Type = xlConditionValueNumber
.Value = 0.270833333
.Operator = 7
.Icon = xlIconNoCellIcon
End With
With Current_Worksheet.Range("C$8:F" & Mid(last_cell, 4, 3)).FormatConditions(2).IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 0.770833334
.Operator = 5
.Icon = xlIconYellowExclamation
End With
' Check for time in 15 minute increments
Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(MINUTE(C8:F" & Mid(last_cell, 4, 3) & "),15)>0"
Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).FormatConditions(3).Interior.Color = 49407
End With
'conditional formatting - text color = green for saturday and red for sunday
For i = 8 To Mid(last_cell, 4, 3)
Current_Worksheet.Range("A" & i & ":" & "P" & i).Select
With Selection
Current_Worksheet.Range("A" & i & ":" & "P" & i).FormatConditions.Add Type:=xlExpression, Formula1:="=TEXT($B" & i & "," & Chr(34) & "Ddd" & Chr(34) & ") =" & Chr(34) & "Sat" & Chr(34) & ""
Current_Worksheet.Range("A" & i & ":" & "P" & i).FormatConditions(7).Font.Color = -16744448
End With
Next i
For i = 8 To Mid(last_cell, 4, 3)
Current_Worksheet.Range("A" & i & ":" & "P" & i).Select
With Selection
Current_Worksheet.Range("A" & i & ":" & "P" & i).FormatConditions.Add Type:=xlExpression, Formula1:="=TEXT($B" & i & "," & Chr(34) & "Ddd" & Chr(34) & ") =" & Chr(34) & "Sun" & Chr(34) & ""
Current_Worksheet.Range("A" & i & ":" & "P" & i).FormatConditions(8).Font.Color = 255
End With
Next i
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 3).Value = "Overtime time will be paid after 8 Hrs ordinary time worked Monday to Friday"
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 3 & ":P" & Mid(last_cell, 4, 3) + 3).Merge
Current_Worksheet.Range("J" & Mid(last_cell, 4, 3) + 3).HorizontalAlignment = xlCenter
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 5).Value = "Employee's Signature:......................................................................................................... Date:.........................................."
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 5).RowHeight = 25
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 5 & ":L" & Mid(last_cell, 4, 3) + 5).MergeCells = True
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 5).HorizontalAlignment = xlLeft
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 6).Value = "Supervisor/Managers Signature:........................................................................................ Date:.........................................."
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 6).RowHeight = 40
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 6).HorizontalAlignment = xlLeft
Current_Worksheet.Range("A3:F4").MergeCells = True
Current_Worksheet.Range("A3").Value = " Enter times in 24 hour format.(7:00=7am 13:00=1pm)" & vbCrLf & "Only valid times between 6:30AM and 6:30PM Accepted"
Current_Worksheet.Range("A3").HorizontalAlignment = xlCenter
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 2).Value = "Times for Saturday shown in Green"
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 2).HorizontalAlignment = xlCenter
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 2).Font.Color = -16744448
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 2 & ":F" & Mid(last_cell, 4, 3) + 2).MergeCells = True
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 3).Value = " Times for Sunday shown in Red"
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 3).HorizontalAlignment = xlCenter
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 3).Font.Color = 255
Current_Worksheet.Range("A" & Mid(last_cell, 4, 3) + 3 & ":F" & Mid(last_cell, 4, 3) + 3).MergeCells = True
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 11).Value = "Missing time"
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 11).HorizontalAlignment = xlLeft
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 10).Value = "Error In calculation"
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 10).HorizontalAlignment = xlLeft
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 11).Value = "Time not a multiple of 15 Minutes"
Current_Worksheet.Range("H" & Mid(last_cell, 4, 3) + 11).HorizontalAlignment = xlLeft
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 9).Value = "Outside 6:30am-6:30pm"
Current_Worksheet.Range("M" & Mid(last_cell, 4, 3) + 9).HorizontalAlignment = xlLeft
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 5).Value = "Green = Correct Data"
Excel_Workbook.Worksheets("Summary").Range("I" & Mid(last_cell1, 4, 3) + 5).Value = "Red = Incorrect Data"
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 6).Value = "Green = All Employee Sheets Updated Correctly"
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 7).Value = "Red = Not all Employee Sheets Updated Correctly"
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 5).Characters(Start:=1, Length:=5).Font.Color = -11489280
Excel_Workbook.Worksheets("Summary").Range("I" & Mid(last_cell1, 4, 3) + 5).Characters(Start:=1, Length:=3).Font.Color = -16776961
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 6).Characters(Start:=1, Length:=5).Font.Color = -11489280
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 7).Characters(Start:=1, Length:=3).Font.Color = -16776961
Excel_Workbook.Worksheets("Summary").Range("A$7:L" & Mid(last_cell1, 4, 3)).Select
With Selection
Excel_Workbook.Worksheets("Summary").ListObjects.Add(xlSrcRange, , xlYes, xlYes).Name = "List1"
Excel_Workbook.Worksheets("Summary").ListObjects("List1").TableStyle = "TableStyleMedium10"
End With
Excel_Workbook.Worksheets("Summary").Range("D" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($D8:$D" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("E" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($E8:$E" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("F" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($F8:$F" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("G" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($G8:$G" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("H" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($H8:$H" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("I" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($I8:$I" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("J" & Mid(last_cell1, 4, 3) + 2).Formula = "=SUM($J8:$J" & Mid(last_cell1, 4, 3) & ")"
Excel_Workbook.Worksheets("Summary").Range("C" & Mid(last_cell1, 4, 3) + 2 & ":J" & Mid(last_cell1, 4, 3) + 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Excel_Workbook.Worksheets("Summary").Range("C" & Mid(last_cell1, 4, 3) + 2).Value = "Totals"
Excel_Workbook.Worksheets("Summary").Range("C" & Mid(last_cell1, 4, 3) + 2 & ":J" & Mid(last_cell1, 4, 3) + 2).Font.Bold = True
Excel_Workbook.Worksheets("Summary").Rows("1:1").Delete
Excel_Workbook.Worksheets("Summary").Rows("3:3").Delete
Excel_Workbook.Worksheets("Summary").Range("A1").Select
Excel_Workbook.Worksheets("Summary").Pictures.Insert("c:\aaa\suzo happ logo.png").Select ' from my desktop, works fine
With Selection
.ShapeRange.ScaleWidth 0.27, msoFalse, msoScaleFromTopLeft
.ShapeRange.IncrementTop 0
.ShapeRange.IncrementLeft 25
End With
Excel_Workbook.Worksheets("Summary").Range("G3").Value = "Please advise of any new staff or staff who have resigned"
Excel_Workbook.Worksheets("Summary").Range("A:A").ColumnWidth = 7
Excel_Workbook.Worksheets("Summary").Range("B:B").ColumnWidth = 33
Excel_Workbook.Worksheets("Summary").Range("C:C").ColumnWidth = 8.11
Excel_Workbook.Worksheets("Summary").Range("D:D").ColumnWidth = 8
Excel_Workbook.Worksheets("Summary").Range("E:E").ColumnWidth = 7
Excel_Workbook.Worksheets("Summary").Range("F:F").ColumnWidth = 7
Excel_Workbook.Worksheets("Summary").Range("G:G").ColumnWidth = 7
Excel_Workbook.Worksheets("Summary").Range("H:H").ColumnWidth = 7
Excel_Workbook.Worksheets("Summary").Range("I:I").ColumnWidth = 9
Excel_Workbook.Worksheets("Summary").Range("J:J").ColumnWidth = 8
Excel_Workbook.Worksheets("Summary").Range("K:K").ColumnWidth = 9
Excel_Workbook.Worksheets("Summary").Range("L:L").ColumnWidth = 27
' text boxes - index, left, top, wide, high
Excel_Workbook.Worksheets("Summary").Shapes.AddTextbox(1, 800, 135, 230, 60).TextFrame.Characters.Text = "This Summary can be deleted if" & Chr(13) & " not required. This will not effect any" & Chr(13) & " Cell Formulas on Employee Sheets." ' " & Chr(13) & "
Excel_Workbook.Worksheets("Summary").Shapes(2).Fill.ForeColor.RGB = RGB(242, 220, 219)
Excel_Workbook.Worksheets("Summary").Shapes(2).TextFrame2.TextRange.Font.Size = 14
Excel_Workbook.Worksheets("Summary").Shapes(2).TextFrame2.TextRange.Font.Name = "Times New Roman"
Excel_Workbook.Worksheets("Summary").Shapes.AddTextbox(1, 800, 205, 230, 60).TextFrame.Characters.Text = "Individual sheet names are based on" & Chr(13) & " the employee name on each sheet."
Excel_Workbook.Worksheets("Summary").Shapes(3).Fill.ForeColor.RGB = RGB(242, 220, 219)
Excel_Workbook.Worksheets("Summary").Shapes(3).TextFrame2.TextRange.Font.Size = 14
Excel_Workbook.Worksheets("Summary").Shapes(3).TextFrame2.TextRange.Font.Name = "Times New Roman"
Excel_Workbook.Worksheets("Summary").Shapes.AddTextbox(1, 800, 275, 230, 130).TextFrame.Characters.Text = "The layout of the column headings is for the Print View of the workbook, they may not show completley while viewing the worksheet in edit mode. The column widths cannot be changed while the worksheet is protected."
Excel_Workbook.Worksheets("Summary").Shapes(4).Fill.ForeColor.RGB = RGB(242, 220, 219)
Excel_Workbook.Worksheets("Summary").Shapes(4).TextFrame2.TextRange.Font.Size = 14
Excel_Workbook.Worksheets("Summary").Shapes(4).TextFrame2.TextRange.Font.Name = "Times New Roman"
Excel_Workbook.Worksheets("Summary").Buttons.Add(800, 5, 230, 40).Select
Excel_Workbook.Worksheets("Summary").Buttons(1).Select
Excel_Workbook.Worksheets("Summary").Buttons(1).Characters.Text = "Print Preview"
Excel_Workbook.Worksheets("Summary").Buttons(1).OnAction = "print_preview"
Excel_Workbook.Worksheets("Summary").Buttons(1).Font.Name = "Times New Roman"
Excel_Workbook.Worksheets("Summary").Buttons(1).Font.Size = 34
Excel_Workbook.Worksheets("Summary").Buttons.Add(800, 55, 230, 40).Select
Excel_Workbook.Worksheets("Summary").Buttons(2).Select
Excel_Workbook.Worksheets("Summary").Buttons(2).Characters.Text = "Save & Email"
Excel_Workbook.Worksheets("Summary").Buttons(2).OnAction = "Send_Mail"
Excel_Workbook.Worksheets("Summary").Buttons(2).Font.Name = "Times New Roman"
Excel_Workbook.Worksheets("Summary").Buttons(2).Font.Size = 34
With Excel_Workbook.Worksheets("Summary").Range("A6:L" & Mid(last_cell1, 4, 3) - 2).Select
Selection.Borders(xlEdgeLeft).Weight = xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeBottom).Weight = xlThin
Selection.Borders(xlEdgeRight).Weight = xlThin
Selection.Borders(xlInsideVertical).Weight = xlHairline
Selection.Borders(xlInsideHorizontal).Weight = xlHairline
End With
With Excel_Workbook.Worksheets("Summary").Range("A5:L5").Select ' Range("List1_1[#All]").Select
Selection.Borders(xlEdgeLeft).Weight = xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeRight).Weight = xlThin
End With
Excel_Workbook.Worksheets("Summary").Range("6:6").Select
Excel_Application.ActiveWindow.FreezePanes = True
Excel_Application.ActiveWindow.TabRatio = 0.75
With Excel_Workbook.Worksheets("Summary").PageSetup
.PaperSize = xlPaperA4
.PrintTitleRows = "$1:$5"
.CenterHorizontally = True
.Zoom = 100
.CenterFooter = "Page &P of &N"
.CenterHeader = ""
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 10
.FooterMargin = 0
.Orientation = xlLandscape
.PrintArea = ("$A$1:$L$" & Mid(last_cell1, 4, 3))
End With
'Protect worksheet cells
Excel_Workbook.Worksheets("Summary").Cells.Locked = True
Excel_Workbook.Worksheets("Summary").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="finance1"
Excel_Workbook.Worksheets("Summary").EnableSelection = xlUnlockedCells
Excel_Application.DisplayAlerts = False
Excel_Workbook.SaveAs filename:="C:\aaa\timesheets\Employee Time Report for - " & sdt & " to " & edt & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
t = Len(Dir("C:\timesheet backups"))
If t = 0 Then
Else
Excel_Workbook.SaveAs filename:="C:\timesheet backups\Employee Time Report for - " & sdt & " to " & edt & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Excel_Application.DisplayAlerts = True
Kill "C:\aaa\timesheets\Employee Time Report Master.xls"
End Sub