Thought that might be the case..
See Below:
Public Sub GenReps1()
On Error GoTo ErrorHandler
Dim xLApp As Excel.Application
Dim wb As Excel.Workbook
Dim db As Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim iRowCount As Integer
Dim iBorder As Integer
Dim iFieldNum As Integer
Dim iRecordCount As Integer
Dim s As String
Dim sSQL As String
Dim sDate As String
Dim sPath As String
Dim sFile As String
Dim sSysMsg As String
Dim vSysCmd As Variant
sSysMsg = "Creating Reports"
Set xLApp = New Excel.Application
Set wb = xLApp.Workbooks.Add()
Set db = CurrentDb
sSQL = "SELECT * " _
& "FROM tblSCMReportFinal;"
Debug.Print sSQL
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
With rs
..MoveLast 'force error 3021 if no records
..MoveFirst
iRecordCount = .RecordCount
vSysCmd = SysCmd(acSysCmdInitMeter, sSysMsg, iRecordCount)
End With
xLApp.Visible = True
With wb.Worksheets(1)
..Name = "SCM Reporting"
..Cells(1, 1).Value = "Total Hours for ES06SCM/ES06SCM and OVH"
..Cells(3, 1).Value = "Time Period:" & Begin1() & " - " & End1()
i = 4
' Set the field names
For iFieldNum = 1 To rs.Fields.Count
..Cells(i, iFieldNum).Value = rs.Fields(iFieldNum - 1).Name
..Cells(i, iFieldNum).Borders.LineStyle = xlContinuous
..Cells(i, iFieldNum).Font.Name = "Arial Narrow"
..Cells(i, iFieldNum).Interior.Color = 10092543
..Cells(i, iFieldNum).HorizontalAlignment = xlCenter
..Cells(i, iFieldNum).VerticalAlignment = xlCenter
Next
i = i + 1
Do Until rs.EOF
For iFieldNum = 1 To rs.Fields.Count
..Cells(i, iFieldNum).Value = Nz(rs.Fields(iFieldNum - 1), "")
..Cells(i, iFieldNum).Borders.LineStyle = xlContinuous
..Cells(i, iFieldNum).Font.Name = "Arial Narrow"
..Cells(i, iFieldNum).HorizontalAlignment = xlCenter
..Cells(i, iFieldNum).VerticalAlignment = xlCenter
Next
vSysCmd = SysCmd(acSysCmdUpdateMeter, i)
i = i + 1
rs.MoveNext
Loop
iRowCount = i - 1
Dim bRow As Integer
bRow = rs.RecordCount + 4
Dim Bigrg As String
Bigrg = "a4:e" & bRow
..Range("A1:E1").Merge
..Range("A1:E1").HorizontalAlignment = xlCenter
..Range("A1:E1").Interior.Color = 10092543
..Range("A1:E1").Font.Bold = True
..Range("A3:E3").Merge
..Range("A3:E3").HorizontalAlignment = xlCenter
'.Range("A3:F3").Interior.Color = 10092543
..Range("A3:E3").Font.Bold = True
..Range(Bigrg).Subtotal Groupby:=1, Function:=xlSum, TotalList:=Array(5)
Dim finrng As String
Selection.SpecialCells(xlCellTypeLastCell).Activate
finrng = "A5:" & xLApp.ActiveCell.Address
ActiveSheet.Outline.ShowLevels RowLevels:=2
.Range(finrng).Select
Selection.SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Bold = True
End With
ActiveSheet.Outline.ShowLevels RowLevels:=3
..Range("a:e").EntireColumn.AutoFit
With .PageSetup
..LeftFooter = "Created &T &D"
..CenterFooter = "&P of &N"
..LeftMargin = xLApp.InchesToPoints(0.42)
..RightMargin = xLApp.InchesToPoints(0.47)
..TopMargin = xLApp.InchesToPoints(0.52)
..BottomMargin = xLApp.InchesToPoints(0.55)
..HeaderMargin = xLApp.InchesToPoints(0.5)
..FooterMargin = xLApp.InchesToPoints(0.35)
..PrintTitleRows = "$1:$2"
..PrintComments = xlPrintNoComments
..PrintQuality = 600
..Orientation = xlPortrait
..PaperSize = xlPaperLetter
..Zoom = False
..FitToPagesTall = 100
..FitToPagesWide = 1
..FirstPageNumber = xlAutomatic
..Order = xlDownThenOver
End With
End With
sDate = Format(Begin1(), "mm-dd-yyyy") & " - " & Format(End1(), "mm-dd-yyyy")
sPath = "\\NTFS2\AFLACGlobal\PMO\EPO Reporting\Monthly Timesheet
Reporting\Current Reports\"
sFile = "05- SCM Monthly Timesheet Report"
wb.SaveAs sPath & sFile & " " & sDate & ".xls"
Set wb = Nothing
xLApp.Quit
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 3021
Case Else
MsgBox "Problem with CreateXLChart()" & vbCrLf _
& "Error " & Err.Number & ": " & Err.Description
End Select
End Sub
--
Michal Joyce
Project Management IS Analyst
Aflac - Project Management Office
Douglas J. Steele said:
Pretty much impossible for anyone to offer any suggestions without seeing
your code.