Hi, I need to export several queries to the same workbook, but send each of them to thier own worksheet.
I have been exporting to seperate workbooks but I now need to do it to the same one.
I am looping through a list of employees selected for export, each one gets thier own sheet in the workbook.
I have several issues,
At the start no excel is open, then after the first employee the excel file is open, i need some way to detect this
i need to put each one into its own sheet and name it after the employee
i then have to format the sheet (this part is ok and working)
then create a new sheet for the next employee and export the data to it
and so on for all selected employees.
i have been looking at various way to do this but i'm stuck.
the code below has been cut from my form vba, i have removed a lot of the formatting as all of that works fine, when this is done into seperate workbooks. who can i modify it for 1 workbook with multiple sheets?
Also am i right in thinking that the line Dim Excel_Application As Object is used to set early or late binding and i only have to comment out this line to switch between the two?
Private Sub Command94_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim gg As String
sdt = Format(start_date, "dd-mm-yy")
edt = Format(End_date, "dd-mm-yy")
' GO
Set db = CurrentDb()
Set rs = db.OpenRecordset("create excel time sheets for selected employees on main menu")
With rs
.MoveFirst
Do While Not .EOF
fn = rs.Fields("First Name")
Ln = rs.Fields("Last Name")
ns = rs.Fields("Normal Start Time")
ne = rs.Fields("Normal End Time")
bc = rs.Fields("Barcode")
gg = "C:\aaa\timesheets\Employee Time Report for - " & fn & ", " & Ln & ", " & sdt & " to " & edt & ".xls"
t = Len(Dir(gg))
If t = 0 Then
GoTo keepgoing1
Else
t = MsgBox("File already exists, Delete file and continue ?.", vbYesNo, "")
If t = vbYes Then
Kill gg
Else
Exit Sub
End If
End If
keepgoing1:
On Error Resume Next
Me.barcode = bc
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "print time sheets for selected employees", gg, True
On Error GoTo 0
Dim Excel_Application As Object
Set Excel_Application = CreateObject("Excel.Application")
Set Excel_Workbook = GetObject(gg)
Excel_Application.WindowState = xlMaximized
Excel_Application.Visible = True
Excel_Workbook.Windows(1).Visible = True
Excel_Workbook.Worksheets(1).Name = fn & " " & Ln
Set Current_Worksheet = Excel_Workbook.Worksheets(fn & " " & Ln)
Excel_Workbook.Worksheets("Employee Time Report").Select
Excel_Workbook.Worksheets("Employee Time Report").Tab.ColorIndex = 37
Excel_Application.FormulaBarHeight = 1
Current_Worksheet.Cells.Select
With Selection
Current_Worksheet.Cells.HorizontalAlignment = xlRight
Current_Worksheet.Cells.Font.Name = "Times New Roman"
End With
Current_Worksheet.PageSetup.Orientation = xlLandscape
Current_Worksheet.Range("A1:P1").HorizontalAlignme nt = xlCenter
Current_Worksheet.Range("A1:P1").VerticalAlignment = xlCenter
Current_Worksheet.Range("A1:P1").Font.Bold = True
Current_Worksheet.Range("C:F").NumberFormat = "h:mm"
Current_Worksheet.Cells.SpecialCells(xlCellTypeLas tCell).Select
last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLas tCell).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
Current_Worksheet.Rows("2:2").Insert Shift:=xlDown
Current_Worksheet.Range("A3:J3").Copy
Current_Worksheet.Range("A2:J2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Current_Worksheet.Range("A$1:P" & Mid(last_cell, 4, 3) + 1).Select
With Selection
Current_Worksheet.ListObjects.Add(xlSrcRange, , xlYes, xlYes).Name = "List1"
End With
'' sums go here
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),ISBLA NK(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) & ")"
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
With Current_Worksheet.PageSetup
.PrintTitleRows = "$1:$7"
.PrintArea = ("$A$1:$P$" & Mid(last_cell, 4, 3) + 11)
.CenterHorizontally = True
.Zoom = 100
.CenterFooter = "Page &P of &N"
.CenterHeader = ""
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 2
.FooterMargin = 0
End With
DoEvents
.MoveNext
Loop
End With
Excel_Workbook.SaveAs "C:\aaa\timesheets\Employee Time Report for - " & sdt & " to " & edt & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Excel_Application.Quit
Kill "C:\aaa\timesheets\Employee Time Report for - " & sdt & " to " & edt & ".xls"
rs.Close
Set rs = Nothing
Set db = Nothing
t = MsgBox("All requested Excel Time Sheets have been created" & vbCrLf & " And saved in the following directory" & vbCrLf & vbCrLf & " C:\aaa\timesheets", vbOKOnly, "Automated Time Sheet Generation")
End Sub