Automation requeries a lot of code so there is not enough space to post the
entire process, but here are some samples
In the part, the instance of Excel is created, the Excel objects are
enstansiated, and the active sheet is established
'---------------------------------------------------------------------------------------
' Module : Form_frmHeadcount
' DateTime : 3/21/2006 08:38
' Author : Dave Hargis
' Purpose : Creates Head Count Chart
'---------------------------------------------------------------------------------------
Private xlApp As Object 'Application Object
Private xlBook As Object 'Workbook Object
Private xlSheet As Object 'Worksheet Object
Private xlChartObj As Object 'Chart Object for Charts
Private rstActual As Recordset 'Recordset to load Actual Data
Private rstPlan As Recordset 'Recordset to load Plan Data
Private rstItms As Recordset 'Recordset to load ITM/Program Manager
Name in Header
Private rstPipeline As Recordset 'Recordset for Pipeline data
Private strItmPM As String 'So we know which we are processing
Private blnRecurring 'Determines if we are doing Recurring or
Non Recurring
'---------------------------------------------------------------------------------------
' Procedure : Build_XL_Report
' DateTime : 3/21/2006 08:38
' Author : Dave Hargis
' Purpose : Creates the Excel Object
'---------------------------------------------------------------------------------------
'
Sub Build_XL_Report()
Dim varGetFileName As Variant 'File Name with Full Path
Dim lngItmCount As Long 'Number of ITMs in the RecordSet
Dim strDefaultDir 'Where to save spreadsheet
Dim strDefaultFileName 'Name to Save as
Dim lngFlags As Long 'Flags for common dialog
Dim strFilter As String 'File Display for Common Dialog
Dim strCurrMonth As String 'To create directory name for save
Dim strCurrYear As String 'To create directory name for save
On Error GoTo Build_XL_Report_Error
DoCmd.Hourglass (True)
Me.txtStatus = "Creating Workbook"
Me.txtStatus.Visible = True
Me.Repaint
'Shows if we are doing Recurring or Non Recurring report
blnRecurring = IIf(Me.opgRecurring = 1, True, False) ' True for Recurring
'Set up the necessary Excel Objcts
On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
'Set error trapping back on
On Error GoTo Build_XL_Report_Error
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Add
'Remove excess worksheets
Do While xlBook.Worksheets.Count > 1
xlApp.Worksheets(xlApp.Worksheets.Count).Delete
Loop
Set xlSheet = xlBook.ActiveSheet
*********************************************
Here, we do some formatting of the sheet:
Sub FormatSheet()
'D A Hargis 5/2005
'Formats the data sheet
'Variables for positioning formatting
Dim strLeftRange As String
Dim strRightRange As String
'Put Borders around the Data Areas
'Forecast area
strLeftRange = "A28"
strRightRange = IIf(blnRecurring, "M32", "M36")
With xlSheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With
'Actuals area
strLeftRange = IIf(blnRecurring, "A34", "A38")
strRightRange = IIf(blnRecurring, "M38", "M42")
With xlSheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With
'Variance area
strLeftRange = IIf(blnRecurring, "A40", "A44")
strRightRange = IIf(blnRecurring, "M44", "M48")
With xlSheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With
'Set up data formatting
With xlSheet
'Forecast data and if NR, Pipeline data
strLeftRange = "B29"
strRightRange = IIf(blnRecurring, "M30", "M32")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Actual data
strLeftRange = IIf(blnRecurring, "B35", "B39")
strRightRange = IIf(blnRecurring, "M36", "M40")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Variance Data
strLeftRange = IIf(blnRecurring, "B41", "B45")
strRightRange = IIf(blnRecurring, "M42", "M46")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Forecast SP
strLeftRange = IIf(blnRecurring, "B31", "B33")
strRightRange = IIf(blnRecurring, "M32", "M36")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Actual SP
strLeftRange = IIf(blnRecurring, "B37", "B41")
strRightRange = IIf(blnRecurring, "M38", "M42")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Variance SP
strLeftRange = IIf(blnRecurring, "B43", "B47")
strRightRange = IIf(blnRecurring, "M44", "M48")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
End With
'Misc formatting
With xlSheet
.Columns("A").ColumnWidth = 14
.Columns("B:M").ColumnWidth = 11
strLeftRange = "A26"
strRightRange = IIf(blnRecurring, "M44", "M48")
For Each cell In xlSheet.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.name = "MS Sans Serif"
Next
For Each cell In xlSheet.Range("B27", "M27")
cell.Font.Bold = True
Next
.Cells(28, 1).Font.Bold = True
.Cells(IIf(blnRecurring, 34, 38), 1).Font.Bold = True
.Cells(IIf(blnRecurring, 40, 44), 1).Font.Bold = True
.Cells(27, 2).Value = "J'" & Right(Me.txtCurrYear, 2)
.Cells(27, 3).Value = "F"
.Cells(27, 4).Value = "M"
.Cells(27, 5).Value = "A"
.Cells(27, 6).Value = "M"
.Cells(27, 7).Value = "J"
.Cells(27, 8).Value = "J"
.Cells(27, 9).Value = "A"
.Cells(27, 10).Value = "S"
.Cells(27, 11).Value = "O"
.Cells(27, 12).Value = "N"
.Cells(27, 13).Value = "D"
.Cells(28, 1).Value = "Forecast"
.Cells(29, 1).Value = "Month"
.Cells(30, 1).Value = "Plan Cum"
.Cells(31, 1).Value = IIf(blnRecurring, "SP mo", "Pipeline Plan")
.Cells(32, 1).Value = IIf(blnRecurring, "SP cum", "Pipeline Cum")
If Not blnRecurring Then
.Cells(33, 1).Value = "SP mo"
.Cells(34, 1).Value = "SP Mo Pipeline"
.Cells(35, 1).Value = "SP cum"
.Cells(36, 1).Value = "SP cum Pipeline"
End If
.Cells(IIf(blnRecurring, 34, 38), 1).Value = "Actual"
.Cells(IIf(blnRecurring, 35, 39), 1).Value = "Month"
.Cells(IIf(blnRecurring, 36, 40), 1).Value = "Act cum"
.Cells(IIf(blnRecurring, 37, 41), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 38, 42), 1).Value = "SP cum"
.Cells(IIf(blnRecurring, 40, 44), 1).Value = "Variance"
.Cells(IIf(blnRecurring, 41, 45), 1).Value = "Month"
.Cells(IIf(blnRecurring, 42, 46), 1).Value = "cum"
.Cells(IIf(blnRecurring, 43, 47), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 44, 48), 1).Value = "SP cum"
End With
'Page Setup For Printing
With xlSheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.LeftFooter = "&F" & " " & "&A"
.RightFooter = "&D" & " " & "&T"
.LeftMargin = xlApp.InchesToPoints(1)
.RightMargin = xlApp.InchesToPoints(0)
.TopMargin = xlApp.InchesToPoints(0.25)
.BottomMargin = xlApp.InchesToPoints(0.5)
.HeaderMargin = xlApp.InchesToPoints(0.25)
.FooterMargin = xlApp.InchesToPoints(0.25)
End With
xlApp.Windows(xlBook.name).Zoom = 75
End Sub
*********************************
Now loading some data:
intRow = IIf(blnRecurring, 36, 40)
With xlSheet
.Cells(intRow, 2).Formula = IIf(blnRecurring, "=+B35", "=+B39")
.Cells(intRow, 3).Formula = IIf(blnRecurring, "=+B36+C35",
"=+B40+C39")
.Cells(intRow, 4).Formula = IIf(blnRecurring, "=+C36+D35",
"=+C40+D39")
.Cells(intRow, 5).Formula = IIf(blnRecurring, "=+D36+E35",
"=+D40+E39")
.Cells(intRow, 6).Formula = IIf(blnRecurring, "=+E36+F35",
"=+E40+F39")
.Cells(intRow, 7).Formula = IIf(blnRecurring, "=+F36+G35",
"=+F40+G39")
.Cells(intRow, 8).Formula = IIf(blnRecurring, "=+G36+H35",
"=+G40+H39")
.Cells(intRow, 9).Formula = IIf(blnRecurring, "=+H36+I35",
"=+H40+I39")
.Cells(intRow, 10).Formula = IIf(blnRecurring, "=+I36+J35",
"=+I40+J39")
.Cells(intRow, 11).Formula = IIf(blnRecurring, "=+J36+K35",
"=+J40+K39")
.Cells(intRow, 12).Formula = IIf(blnRecurring, "=+K36+L35",
"=+K40+L39")
.Cells(intRow, 13).Formula = IIf(blnRecurring, "=+L36+M35",
"=+L40+M39")
'Actual SP mo
intRow = IIf(blnRecurring, 37, 41)
strRow = CStr(intRow - 2)
strSPhrs = "=+B" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '01'"))
.Cells(intRow, 2).Formula = strSPhrs
strSPhrs = "=+C" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '02'"))
.Cells(intRow, 3).Formula = strSPhrs
strSPhrs = "=+D" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '03'"))
.Cells(intRow, 4).Formula = strSPhrs
strSPhrs = "=+E" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '04'"))
.Cells(intRow, 5).Formula = strSPhrs
strSPhrs = "=+F" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '05'"))
.Cells(intRow, 6).Formula = strSPhrs
strSPhrs = "=+G" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '06'"))
.Cells(intRow, 7).Formula = strSPhrs
strSPhrs = "=+H" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '07'"))
.Cells(intRow, 8).Formula = strSPhrs
strSPhrs = "=+I" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '08'"))
.Cells(intRow, 9).Formula = strSPhrs
strSPhrs = "=+J" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '09'"))
.Cells(intRow, 10).Formula = strSPhrs
strSPhrs = "=+K" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '10'"))
.Cells(intRow, 11).Formula = strSPhrs
strSPhrs = "=+L" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '11'"))
.Cells(intRow, 12).Formula = strSPhrs
strSPhrs = "=+M" & strRow & "/" & CStr(DLookup("[HrsPerMonth]", _
"tbllkAcctDate", "[mon]= '12'"))
.Cells(intRow, 13).Formula = strSPhrs
******************************************
And closing it:
xlBook.Close
If blnExcelWasNotRunning = True Then
xlApp.Quit
Else
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
End If
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
*******************************
This is only a portion of the code. Sure you want to do this?
Creating a new worksheet and giving it a name:
Sub CreateNewSheet()
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activate
Set xlSheet = xlBook.ActiveSheet
xlSheet.name = Switch(Me.cboResource = "SEL", "systems", Me.cboResource
= "PSOL", _
"prog mgmt", Me.cboResource = "SUP", "support") _
& IIf(strItmPM = "PM", " pm", "") _
& IIf(blnRecurring, " Rec_", " Nrec_") & rstItms![ITM]
End Sub
********************************
