Pass formula to Excel spreadsheet

My boss is developing an Access database application. In several instances,
clicking a button creates an Excel spreadsheet using relevant data and sends
it in an email.

At the moment, I edit the spreadsheet manually to add formulae in the row at
the bottom of the data. Is it possible for Access to do this automatically
(eg row 1=headers, rows 2 to X =record data, row X+1=formulae in some
columns)

If this is possible, how would we go about achieving this?

On the same spreadsheet, would it also be possible to add formulae to the 3
columns following each data record?

Many thanks in advance.

--
Ian
--

Hi Ian,

Yes, you can do everything you want to accomplish, using automation code.
However, it gets quite a bit more complicated than simply using
DoCmd.SendObject. In this case, you will need to use automation code to
create the spreadsheet, insert the data and applicable formulas, and then
send it to the appropriate recipient(s).

I suggest that you can start to learn how to do this by having a look at the
following links:

Sample Excel Automation
http://www.mvps.org/access/modules/mdl0006.htm

Office XP Automation Help file
http://support.microsoft.com/?kbid=302460

Using Automation to Transfer Data to Microsoft Excel
http://support.microsoft.com/?id=210288

Using Automation to Create a Microsoft Excel Chart
http://support.microsoft.com/?id=202169


Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/ex...tributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

"Ian" wrote:

My boss is developing an Access database application. In several instances,
clicking a button creates an Excel spreadsheet using relevant data and sends
it in an email.

At the moment, I edit the spreadsheet manually to add formulae in the row at
the bottom of the data. Is it possible for Access to do this automatically
(eg row 1=headers, rows 2 to X =record data, row X+1=formulae in some
columns)

If this is possible, how would we go about achieving this?

On the same spreadsheet, would it also be possible to add formulae to the 3
columns following each data record?

Many thanks in advance.

--
Ian

On Fri, 29 Dec 2006 20:17:15 GMT, "Ian" wrote:
My boss is developing an Access database application. In several instances,
clicking a button creates an Excel spreadsheet using relevant data and sends
it in an email.
At the moment, I edit the spreadsheet manually to add formulae in the row at
the bottom of the data. Is it possible for Access to do this automatically
(eg row 1=headers, rows 2 to X =record data, row X+1=formulae in some
columns)
If this is possible, how would we go about achieving this?
On the same spreadsheet, would it also be possible to add formulae to the 3
columns following each data record?

Yes, but you need to use Excel Automation to do this.

Here are some functions to get you started.
As always, watch the word wrap!
Also note: I tried to replace all the Excel constants with their
numerical value so you wouldn't have to do that yourself, or load in
the Excel constants yourself. I hope I got them all, but if I didn't,
sorry. You can find them by opening up Excel, hitting Alt-F11 and
typing in ?XlCenter (or whatever) and Excel will tell you what the
value is.

Sub TestTotaling()
Dim objExcel As Object
Set objExcel = CreateObject("excel.application")
' replace "ExcelFileToUse.xls" with the full path and
' filename of the Excel file to put the totals row
' and column in!
objExcel.Workbooks.Open "ExcelFileToUse.xls"
objExcel.Visible = True
Call AddTotalsColumn(objExcel)
Call AddTotalsRow(objExcel)
objExcel.ActiveWorkbook.Save
objExcel.Application.Quit
Set objExcel = Nothing
Debug.Print "Done!"
End Sub
'----------------------------------------------------------------
Private Function LongToExcelColumnLetter(ColumnNumber As Long) _
As String
If ColumnNumber 26 Then
LongToExcelColumnLetter = _
Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
LongToExcelColumnLetter = Chr(ColumnNumber + 64)
End If
End Function
'----------------------------------------------------------------
Sub AddTotalsRow(objExcel As Object, _
Optional lngStartColumn As Long = 1, _
Optional lngEndColumn As Long = -1, _
Optional ColumnToPutTotalsWordIn As Long = 1, _
Optional strTotalsWording As String = "Totals:", _
Optional lngRowToStartOn As Long = 2, _
Optional bolShade As Boolean = True)
Dim lngColumnToEndOn As Long
Dim lngMaxColumn As Long
Dim strMaxColumn As String
Dim lngMaxRow As Long
Dim strRange As String
Dim strCurrentColumn As String
Dim x As Long
Dim Y As Long
'objExcel.ActiveCell.SpecialCells(11).Select
lngMaxRow = objExcel.Cells.SpecialCells(11).Row + 1
' +1 to make a new max row
lngMaxColumn = objExcel.Cells.SpecialCells(11).Column
strMaxColumn = LongToExcelColumnLetter(lngMaxColumn)
' select entire row:
objExcel.Rows(lngMaxRow & ":" & lngMaxRow).Select
' insert new line
objExcel.Selection.Insert Shift:= -4121 'xlDown
' select entire row
objExcel.Rows(lngMaxRow & ":" & lngMaxRow).Select
' insert new line
objExcel.Selection.Insert Shift:= -4121 'xlDown
lngMaxRow = lngMaxRow + 1
' Color the area and set font to bold:
strRange = "A" & lngMaxRow & ":" & strMaxColumn & lngMaxRow
objExcel.Range(strRange).Select
If bolShade = True Then
objExcel.Selection.Interior.ColorIndex = 15
objExcel.Selection.Interior.Pattern = 1 'xlSolid
End If
objExcel.Selection.Font.Bold = True
objExcel.Selection.VerticalAlignment = -4107 'xlBottom
objExcel.Selection.WrapText = False
objExcel.Selection.Orientation = 0
objExcel.Selection.AddIndent = False
objExcel.Selection.IndentLevel = 0
objExcel.Selection.ShrinkToFit = False
objExcel.Selection.ReadingOrder = -5002 'xlContext
objExcel.Selection.MergeCells = False
objExcel.Selection.HorizontalAlignment = -4152 'xlRight

'Columns("R:R").Select ' selects entire column
'Selection.Insert Shift:= -4161 'xlToRight

If lngEndColumn = -1 Then
lngColumnToEndOn = lngMaxColumn
Else
lngColumnToEndOn = lngEndColumn
End If
If lngEndColumn lngMaxColumn Then
lngColumnToEndOn = lngMaxColumn
End If

For x = lngStartColumn To lngColumnToEndOn
strCurrentColumn = LongToExcelColumnLetter(x)
strRange = strCurrentColumn & lngMaxRow
objExcel.Range(strRange).Activate
objExcel.ActiveCell.Formula = _
"=SUM(" & _
strCurrentColumn & _
lngRowToStartOn & ":" & _
strCurrentColumn & lngMaxRow - 1 & _
")"

'walk up the column and grab the number format
'from the last non-blank cell:
'if objExcel.ActiveCell.Value
Y = lngMaxRow
Do
Y = Y - 1
If IsNull(objExcel.ActiveSheet.Cells(Y, x).Value) = _
False Then
If objExcel.ActiveSheet.Cells(Y, x).Value "" Then
If objExcel.ActiveSheet.Cells(Y, x).Value _
0 Then Exit Do
End If
End If
Loop While Y lngRowToStartOn
If Y = lngRowToStartOn Then
If objExcel.ActiveSheet.Cells(Y, x).NumberFormat _
"@" Then
If objExcel.ActiveSheet.Cells(Y, x).NumberFormat =
"General" Then
objExcel.ActiveCell.NumberFormat = _
"#,##0_);-#,##0"
Else
objExcel.ActiveCell.NumberFormat = _
objExcel.ActiveSheet.Cells(Y, x).NumberFormat
If objExcel.ActiveCell.NumberFormat = _
"m/d/yyyy" Then
' can't calculate totals on a date field!
objExcel.ActiveCell.Formula = ""
End If
End If
Else
objExcel.ActiveCell.NumberFormat = _
"#,##0_);-#,##0" '"General"
End If
If Not IsNull(objExcel.ActiveCell.Value) Then _
If objExcel.ActiveCell.Value = 0 Then _
objExcel.ActiveCell.Formula = ""
Else
' if nothing was found, blank out the sum.
objExcel.ActiveCell.Formula = ""
End If
Next
DoEvents
If ColumnToPutTotalsWordIn 0 Then
strRange = LongToExcelColumnLetter(ColumnToPutTotalsWordIn) &
lngMaxRow
objExcel.Range(strRange).Select
objExcel.Range(strRange).Activate
' make sure cell will accept text
objExcel.Selection.NumberFormat = "@"
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
objExcel.ActiveCell = strTotalsWording
End If
End Sub
'---------------------------------------------------------------------
Sub AddTotalsColumn(objExcel As Object, _
Optional lngStartRow As Long = 1, _
Optional lngEndRow As Long = -1, _
Optional lngTotalsStartColumn As Long = -1, _
Optional lngTotalsEndColumn As Long = -1, _
Optional strColumnHeading As String = "Totals", _
Optional bolShadeColumn As Boolean = True)

Dim lngColumnToStartOn As Long
Dim lngColumnToEndOn As Long
Dim strColumnToStartOn As String
Dim strColumnToEndOn As String
Dim lngRowToEndOn As Long
Dim lngMaxColumn As Long
Dim strMaxColumn As String
Dim lngMaxRow As Long
Dim strRange As String
Dim strCurrentColumn As String
Dim x As Long

lngMaxRow = objExcel.Cells.SpecialCells(11).Row
lngMaxColumn = objExcel.Cells.SpecialCells(11).Column + 1
' The +1 above is to make a new max column
strMaxColumn = LongToExcelColumnLetter(lngMaxColumn)
' select entire column
objExcel.Columns(strMaxColumn & ":" & strMaxColumn).Select
' shift cells to the right
objExcel.Selection.Insert Shift:=-4161 'xlToRight

' Color the area and set font to bold:
strRange = strMaxColumn & "1:" & strMaxColumn & lngMaxRow
objExcel.Range(strRange).Select
If bolShadeColumn = True Then
objExcel.Selection.Interior.ColorIndex = 15
objExcel.Selection.Interior.Pattern = 1 'xlSolid
End If
objExcel.Selection.Font.Bold = True
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
objExcel.Selection.VerticalAlignment = -4107 'xlBottom
objExcel.Selection.WrapText = False
objExcel.Selection.Orientation = 0
objExcel.Selection.AddIndent = False
objExcel.Selection.IndentLevel = 0
objExcel.Selection.ShrinkToFit = False
objExcel.Selection.ReadingOrder = -5002 'xlContext
objExcel.Selection.MergeCells = False

If lngEndRow = -1 Then
lngRowToEndOn = lngMaxRow
End If
If lngEndRow lngMaxRow Then
lngRowToEndOn = lngMaxRow
End If

lngColumnToStartOn = lngTotalsStartColumn
lngColumnToEndOn = lngTotalsEndColumn
If lngTotalsStartColumn = -1 Then
lngColumnToStartOn = lngMaxColumn - 1
End If
If lngTotalsEndColumn = -1 Then
lngColumnToEndOn = lngMaxColumn - 1
End If

strColumnToStartOn = LongToExcelColumnLetter(lngColumnToStartOn)
strColumnToEndOn = LongToExcelColumnLetter(lngColumnToEndOn)

For x = lngStartRow To lngRowToEndOn
strRange = strMaxColumn & x
objExcel.Range(strRange).Activate
objExcel.ActiveCell.Formula = _
"=SUM(" & _
strColumnToStartOn & x & _
":" & _
strColumnToEndOn & x & _
")"
If objExcel.ActiveCell.NumberFormat = _
"$#,##0.00_);($#,##0.00)" Then
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
End If
DoEvents
Next

strRange = strMaxColumn & "1"
objExcel.Range(strRange).Select
objExcel.Range(strRange).Activate
' make sure cell will accept text
objExcel.Selection.NumberFormat = "@"
objExcel.Selection.HorizontalAlignment = -4108 'xlCenter
objExcel.ActiveCell = strColumnHeading
End Sub


--
Drive C: Error. (A)bort (R)etry (S)mack The Darned Thing

Thanks, Tom.

I'll check these out when I get the time. As it's for work, it won't get
done till next year :-)

Happy new year.

--
Ian
--
"Tom Wickerath" AOS168b AT comcast DOT net wrote in message
...
Hi Ian,

Yes, you can do everything you want to accomplish, using automation code.
However, it gets quite a bit more complicated than simply using
DoCmd.SendObject. In this case, you will need to use automation code to
create the spreadsheet, insert the data and applicable formulas, and then
send it to the appropriate recipient(s).

I suggest that you can start to learn how to do this by having a look at
the
following links:

Sample Excel Automation
http://www.mvps.org/access/modules/mdl0006.htm

Office XP Automation Help file
http://support.microsoft.com/?kbid=302460

Using Automation to Transfer Data to Microsoft Excel
http://support.microsoft.com/?id=210288

Using Automation to Create a Microsoft Excel Chart
http://support.microsoft.com/?id=202169


Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/ex...tributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

"Ian" wrote:

My boss is developing an Access database application. In several
instances,
clicking a button creates an Excel spreadsheet using relevant data and
sends
it in an email.

At the moment, I edit the spreadsheet manually to add formulae in the row
at
the bottom of the data. Is it possible for Access to do this
automatically
(eg row 1=headers, rows 2 to X =record data, row X+1=formulae in some
columns)

If this is possible, how would we go about achieving this?

On the same spreadsheet, would it also be possible to add formulae to the
3
columns following each data record?

Many thanks in advance.

--
Ian

Thanks for the very detailed response, Chuck.
I have a lot to look through and try to understand after the new year.

One question, though. Is this code to be used in Access or Excel? It looks
very similar to Excel code, which unfortunately I wouldn't be able to use as
it all has to be done from Access.

Happy new year.
--
Ian
--
"Chuck Grimsby" wrote in message
...
On Fri, 29 Dec 2006 20:17:15 GMT, "Ian" wrote:
My boss is developing an Access database application. In several
instances,
clicking a button creates an Excel spreadsheet using relevant data and
sends
it in an email.
At the moment, I edit the spreadsheet manually to add formulae in the row
at
the bottom of the data. Is it possible for Access to do this automatically
(eg row 1=headers, rows 2 to X =record data, row X+1=formulae in some
columns)
If this is possible, how would we go about achieving this?
On the same spreadsheet, would it also be possible to add formulae to the
3
columns following each data record?

Yes, but you need to use Excel Automation to do this.

Here are some functions to get you started.
As always, watch the word wrap!
Also note: I tried to replace all the Excel constants with their
numerical value so you wouldn't have to do that yourself, or load in
the Excel constants yourself. I hope I got them all, but if I didn't,
sorry. You can find them by opening up Excel, hitting Alt-F11 and
typing in ?XlCenter (or whatever) and Excel will tell you what the
value is.

Sub TestTotaling()
Dim objExcel As Object
Set objExcel = CreateObject("excel.application")
' replace "ExcelFileToUse.xls" with the full path and
' filename of the Excel file to put the totals row
' and column in!
objExcel.Workbooks.Open "ExcelFileToUse.xls"
objExcel.Visible = True
Call AddTotalsColumn(objExcel)
Call AddTotalsRow(objExcel)
objExcel.ActiveWorkbook.Save
objExcel.Application.Quit
Set objExcel = Nothing
Debug.Print "Done!"
End Sub
'----------------------------------------------------------------
Private Function LongToExcelColumnLetter(ColumnNumber As Long) _
As String
If ColumnNumber 26 Then
LongToExcelColumnLetter = _
Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
LongToExcelColumnLetter = Chr(ColumnNumber + 64)
End If
End Function
'----------------------------------------------------------------
Sub AddTotalsRow(objExcel As Object, _
Optional lngStartColumn As Long = 1, _
Optional lngEndColumn As Long = -1, _
Optional ColumnToPutTotalsWordIn As Long = 1, _
Optional strTotalsWording As String = "Totals:", _
Optional lngRowToStartOn As Long = 2, _
Optional bolShade As Boolean = True)
Dim lngColumnToEndOn As Long
Dim lngMaxColumn As Long
Dim strMaxColumn As String
Dim lngMaxRow As Long
Dim strRange As String
Dim strCurrentColumn As String
Dim x As Long
Dim Y As Long
'objExcel.ActiveCell.SpecialCells(11).Select
lngMaxRow = objExcel.Cells.SpecialCells(11).Row + 1
' +1 to make a new max row
lngMaxColumn = objExcel.Cells.SpecialCells(11).Column
strMaxColumn = LongToExcelColumnLetter(lngMaxColumn)
' select entire row:
objExcel.Rows(lngMaxRow & ":" & lngMaxRow).Select
' insert new line
objExcel.Selection.Insert Shift:= -4121 'xlDown
' select entire row
objExcel.Rows(lngMaxRow & ":" & lngMaxRow).Select
' insert new line
objExcel.Selection.Insert Shift:= -4121 'xlDown
lngMaxRow = lngMaxRow + 1
' Color the area and set font to bold:
strRange = "A" & lngMaxRow & ":" & strMaxColumn & lngMaxRow
objExcel.Range(strRange).Select
If bolShade = True Then
objExcel.Selection.Interior.ColorIndex = 15
objExcel.Selection.Interior.Pattern = 1 'xlSolid
End If
objExcel.Selection.Font.Bold = True
objExcel.Selection.VerticalAlignment = -4107 'xlBottom
objExcel.Selection.WrapText = False
objExcel.Selection.Orientation = 0
objExcel.Selection.AddIndent = False
objExcel.Selection.IndentLevel = 0
objExcel.Selection.ShrinkToFit = False
objExcel.Selection.ReadingOrder = -5002 'xlContext
objExcel.Selection.MergeCells = False
objExcel.Selection.HorizontalAlignment = -4152 'xlRight

'Columns("R:R").Select ' selects entire column
'Selection.Insert Shift:= -4161 'xlToRight

If lngEndColumn = -1 Then
lngColumnToEndOn = lngMaxColumn
Else
lngColumnToEndOn = lngEndColumn
End If
If lngEndColumn lngMaxColumn Then
lngColumnToEndOn = lngMaxColumn
End If

For x = lngStartColumn To lngColumnToEndOn
strCurrentColumn = LongToExcelColumnLetter(x)
strRange = strCurrentColumn & lngMaxRow
objExcel.Range(strRange).Activate
objExcel.ActiveCell.Formula = _
"=SUM(" & _
strCurrentColumn & _
lngRowToStartOn & ":" & _
strCurrentColumn & lngMaxRow - 1 & _
")"

'walk up the column and grab the number format
'from the last non-blank cell:
'if objExcel.ActiveCell.Value
Y = lngMaxRow
Do
Y = Y - 1
If IsNull(objExcel.ActiveSheet.Cells(Y, x).Value) = _
False Then
If objExcel.ActiveSheet.Cells(Y, x).Value "" Then
If objExcel.ActiveSheet.Cells(Y, x).Value _
0 Then Exit Do
End If
End If
Loop While Y lngRowToStartOn
If Y = lngRowToStartOn Then
If objExcel.ActiveSheet.Cells(Y, x).NumberFormat _
"@" Then
If objExcel.ActiveSheet.Cells(Y, x).NumberFormat =
"General" Then
objExcel.ActiveCell.NumberFormat = _
"#,##0_);-#,##0"
Else
objExcel.ActiveCell.NumberFormat = _
objExcel.ActiveSheet.Cells(Y, x).NumberFormat
If objExcel.ActiveCell.NumberFormat = _
"m/d/yyyy" Then
' can't calculate totals on a date field!
objExcel.ActiveCell.Formula = ""
End If
End If
Else
objExcel.ActiveCell.NumberFormat = _
"#,##0_);-#,##0" '"General"
End If
If Not IsNull(objExcel.ActiveCell.Value) Then _
If objExcel.ActiveCell.Value = 0 Then _
objExcel.ActiveCell.Formula = ""
Else
' if nothing was found, blank out the sum.
objExcel.ActiveCell.Formula = ""
End If
Next
DoEvents
If ColumnToPutTotalsWordIn 0 Then
strRange = LongToExcelColumnLetter(ColumnToPutTotalsWordIn) &
lngMaxRow
objExcel.Range(strRange).Select
objExcel.Range(strRange).Activate
' make sure cell will accept text
objExcel.Selection.NumberFormat = "@"
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
objExcel.ActiveCell = strTotalsWording
End If
End Sub
'---------------------------------------------------------------------
Sub AddTotalsColumn(objExcel As Object, _
Optional lngStartRow As Long = 1, _
Optional lngEndRow As Long = -1, _
Optional lngTotalsStartColumn As Long = -1, _
Optional lngTotalsEndColumn As Long = -1, _
Optional strColumnHeading As String = "Totals", _
Optional bolShadeColumn As Boolean = True)

Dim lngColumnToStartOn As Long
Dim lngColumnToEndOn As Long
Dim strColumnToStartOn As String
Dim strColumnToEndOn As String
Dim lngRowToEndOn As Long
Dim lngMaxColumn As Long
Dim strMaxColumn As String
Dim lngMaxRow As Long
Dim strRange As String
Dim strCurrentColumn As String
Dim x As Long

lngMaxRow = objExcel.Cells.SpecialCells(11).Row
lngMaxColumn = objExcel.Cells.SpecialCells(11).Column + 1
' The +1 above is to make a new max column
strMaxColumn = LongToExcelColumnLetter(lngMaxColumn)
' select entire column
objExcel.Columns(strMaxColumn & ":" & strMaxColumn).Select
' shift cells to the right
objExcel.Selection.Insert Shift:=-4161 'xlToRight

' Color the area and set font to bold:
strRange = strMaxColumn & "1:" & strMaxColumn & lngMaxRow
objExcel.Range(strRange).Select
If bolShadeColumn = True Then
objExcel.Selection.Interior.ColorIndex = 15
objExcel.Selection.Interior.Pattern = 1 'xlSolid
End If
objExcel.Selection.Font.Bold = True
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
objExcel.Selection.VerticalAlignment = -4107 'xlBottom
objExcel.Selection.WrapText = False
objExcel.Selection.Orientation = 0
objExcel.Selection.AddIndent = False
objExcel.Selection.IndentLevel = 0
objExcel.Selection.ShrinkToFit = False
objExcel.Selection.ReadingOrder = -5002 'xlContext
objExcel.Selection.MergeCells = False

If lngEndRow = -1 Then
lngRowToEndOn = lngMaxRow
End If
If lngEndRow lngMaxRow Then
lngRowToEndOn = lngMaxRow
End If

lngColumnToStartOn = lngTotalsStartColumn
lngColumnToEndOn = lngTotalsEndColumn
If lngTotalsStartColumn = -1 Then
lngColumnToStartOn = lngMaxColumn - 1
End If
If lngTotalsEndColumn = -1 Then
lngColumnToEndOn = lngMaxColumn - 1
End If

strColumnToStartOn = LongToExcelColumnLetter(lngColumnToStartOn)
strColumnToEndOn = LongToExcelColumnLetter(lngColumnToEndOn)

For x = lngStartRow To lngRowToEndOn
strRange = strMaxColumn & x
objExcel.Range(strRange).Activate
objExcel.ActiveCell.Formula = _
"=SUM(" & _
strColumnToStartOn & x & _
":" & _
strColumnToEndOn & x & _
")"
If objExcel.ActiveCell.NumberFormat = _
"$#,##0.00_);($#,##0.00)" Then
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
End If
DoEvents
Next

strRange = strMaxColumn & "1"
objExcel.Range(strRange).Select
objExcel.Range(strRange).Activate
' make sure cell will accept text
objExcel.Selection.NumberFormat = "@"
objExcel.Selection.HorizontalAlignment = -4108 'xlCenter
objExcel.ActiveCell = strColumnHeading
End Sub


--
Drive C: Error. (A)bort (R)etry (S)mack The Darned Thing

Hi Ian,

The code that Chuck gave you can be used from within Access. It may look
similar to Excel code, and could likely be used within Excel, since all
Office applications use VBA (Visual Basic for Applications) as the
programming language.

The code that Chuck provided to you is considered late bound code. As such,
it does not require a checked reference to the Microsoft Excel {version}
Object Library. While this means that you will not get the benefit of
intellisense, it does make the code more reliable, since it does not depend
on a version specific reference. You can convert the code to early bound
code, if you want to use intellisense, and then later convert it back to late
bound, when you are satisified that your changes are working properly.


Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/ex...tributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

"Ian" wrote:

Thanks for the very detailed response, Chuck.
I have a lot to look through and try to understand after the new year.

One question, though. Is this code to be used in Access or Excel? It looks
very similar to Excel code, which unfortunately I wouldn't be able to use as
it all has to be done from Access.

Happy new year.
--
Ian

It's all done in Access. I tend not to do things in Excel unless I
have to. Ok, so I'm biased.... I'm a database guy and make no bones
about it. Excel isn't too bad however, for presenting data _from_ a
database. (Especially when you *don't* want the data back! *Grin!* )



On Sat, 30 Dec 2006 21:53:44 GMT, "Ian" wrote:

Thanks for the very detailed response, Chuck.
I have a lot to look through and try to understand after the new year.

One question, though. Is this code to be used in Access or Excel? It looks
very similar to Excel code, which unfortunately I wouldn't be able to use as
it all has to be done from Access.

Happy new year.
--
Ian


--
Drive C: Error. (A)bort (R)etry (S)mack The Darned Thing

Thanks for the explanation, Tom.

--
Ian
--
"Tom Wickerath" AOS168b AT comcast DOT net wrote in message
...
Hi Ian,

The code that Chuck gave you can be used from within Access. It may look
similar to Excel code, and could likely be used within Excel, since all
Office applications use VBA (Visual Basic for Applications) as the
programming language.

The code that Chuck provided to you is considered late bound code. As
such,
it does not require a checked reference to the Microsoft Excel {version}
Object Library. While this means that you will not get the benefit of
intellisense, it does make the code more reliable, since it does not
depend
on a version specific reference. You can convert the code to early bound
code, if you want to use intellisense, and then later convert it back to
late
bound, when you are satisified that your changes are working properly.


Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/ex...tributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

"Ian" wrote:

Thanks for the very detailed response, Chuck.
I have a lot to look through and try to understand after the new year.

One question, though. Is this code to be used in Access or Excel? It
looks
very similar to Excel code, which unfortunately I wouldn't be able to use
as
it all has to be done from Access.

Happy new year.
--
Ian

I have to admit to being a bit of an Excel fan, perhaps only becaue I've had
little to do with Access (though I'm beginning to get into it..... slowly).
They both have their advantages and disadvantages as far as I can see, but
they were designed for different purposes, so that's to be expected. I'll
have a closer look at the code when I get back to work after the new year.

Many thanks & happy new year.

--
Ian
--
"Chuck Grimsby" wrote in message
...

It's all done in Access. I tend not to do things in Excel unless I
have to. Ok, so I'm biased.... I'm a database guy and make no bones
about it. Excel isn't too bad however, for presenting data _from_ a
database. (Especially when you *don't* want the data back! *Grin!* )



On Sat, 30 Dec 2006 21:53:44 GMT, "Ian" wrote:

Thanks for the very detailed response, Chuck.
I have a lot to look through and try to understand after the new year.

One question, though. Is this code to be used in Access or Excel? It looks
very similar to Excel code, which unfortunately I wouldn't be able to use
as
it all has to be done from Access.

Happy new year.
--
Ian


--
Drive C: Error. (A)bort (R)etry (S)mack The Darned Thing

Hi Chuck

I seem to have fallen at the first hurdle, I'm afraid :-(

The existing database application uses a macro of 3 actions for one of the
email outputs. The 1st action is "SendObject" which sends an Access "Form"
with "Microsoft Excel" as te "Output Format". Thus, until the action has
been carried out, the spreadsheet does not exist. Once it does exist, it is
an email attachment called Expenses.xls. If Outlook has a connection to the
email server, the email will be sent.

Question: How can I open the Excel spreadsheet to add rows/columns before it
becomes an attachment to an email?

As I said before, I'm *slowly* learning Access and may be completely wrong
with the description of what's happening.

I'm happy to experiment with the code, but I need to be able to open the
spreadsheet first.

--
Ian
--
"Chuck Grimsby" wrote in message
...
On Fri, 29 Dec 2006 20:17:15 GMT, "Ian" wrote:
My boss is developing an Access database application. In several
instances,
clicking a button creates an Excel spreadsheet using relevant data and
sends
it in an email.
At the moment, I edit the spreadsheet manually to add formulae in the row
at
the bottom of the data. Is it possible for Access to do this automatically
(eg row 1=headers, rows 2 to X =record data, row X+1=formulae in some
columns)
If this is possible, how would we go about achieving this?
On the same spreadsheet, would it also be possible to add formulae to the
3
columns following each data record?

Yes, but you need to use Excel Automation to do this.

Here are some functions to get you started.
As always, watch the word wrap!
Also note: I tried to replace all the Excel constants with their
numerical value so you wouldn't have to do that yourself, or load in
the Excel constants yourself. I hope I got them all, but if I didn't,
sorry. You can find them by opening up Excel, hitting Alt-F11 and
typing in ?XlCenter (or whatever) and Excel will tell you what the
value is.

Sub TestTotaling()
Dim objExcel As Object
Set objExcel = CreateObject("excel.application")
' replace "ExcelFileToUse.xls" with the full path and
' filename of the Excel file to put the totals row
' and column in!
objExcel.Workbooks.Open "ExcelFileToUse.xls"
objExcel.Visible = True
Call AddTotalsColumn(objExcel)
Call AddTotalsRow(objExcel)
objExcel.ActiveWorkbook.Save
objExcel.Application.Quit
Set objExcel = Nothing
Debug.Print "Done!"
End Sub
'----------------------------------------------------------------
Private Function LongToExcelColumnLetter(ColumnNumber As Long) _
As String
If ColumnNumber 26 Then
LongToExcelColumnLetter = _
Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
LongToExcelColumnLetter = Chr(ColumnNumber + 64)
End If
End Function
'----------------------------------------------------------------
Sub AddTotalsRow(objExcel As Object, _
Optional lngStartColumn As Long = 1, _
Optional lngEndColumn As Long = -1, _
Optional ColumnToPutTotalsWordIn As Long = 1, _
Optional strTotalsWording As String = "Totals:", _
Optional lngRowToStartOn As Long = 2, _
Optional bolShade As Boolean = True)
Dim lngColumnToEndOn As Long
Dim lngMaxColumn As Long
Dim strMaxColumn As String
Dim lngMaxRow As Long
Dim strRange As String
Dim strCurrentColumn As String
Dim x As Long
Dim Y As Long
'objExcel.ActiveCell.SpecialCells(11).Select
lngMaxRow = objExcel.Cells.SpecialCells(11).Row + 1
' +1 to make a new max row
lngMaxColumn = objExcel.Cells.SpecialCells(11).Column
strMaxColumn = LongToExcelColumnLetter(lngMaxColumn)
' select entire row:
objExcel.Rows(lngMaxRow & ":" & lngMaxRow).Select
' insert new line
objExcel.Selection.Insert Shift:= -4121 'xlDown
' select entire row
objExcel.Rows(lngMaxRow & ":" & lngMaxRow).Select
' insert new line
objExcel.Selection.Insert Shift:= -4121 'xlDown
lngMaxRow = lngMaxRow + 1
' Color the area and set font to bold:
strRange = "A" & lngMaxRow & ":" & strMaxColumn & lngMaxRow
objExcel.Range(strRange).Select
If bolShade = True Then
objExcel.Selection.Interior.ColorIndex = 15
objExcel.Selection.Interior.Pattern = 1 'xlSolid
End If
objExcel.Selection.Font.Bold = True
objExcel.Selection.VerticalAlignment = -4107 'xlBottom
objExcel.Selection.WrapText = False
objExcel.Selection.Orientation = 0
objExcel.Selection.AddIndent = False
objExcel.Selection.IndentLevel = 0
objExcel.Selection.ShrinkToFit = False
objExcel.Selection.ReadingOrder = -5002 'xlContext
objExcel.Selection.MergeCells = False
objExcel.Selection.HorizontalAlignment = -4152 'xlRight

'Columns("R:R").Select ' selects entire column
'Selection.Insert Shift:= -4161 'xlToRight

If lngEndColumn = -1 Then
lngColumnToEndOn = lngMaxColumn
Else
lngColumnToEndOn = lngEndColumn
End If
If lngEndColumn lngMaxColumn Then
lngColumnToEndOn = lngMaxColumn
End If

For x = lngStartColumn To lngColumnToEndOn
strCurrentColumn = LongToExcelColumnLetter(x)
strRange = strCurrentColumn & lngMaxRow
objExcel.Range(strRange).Activate
objExcel.ActiveCell.Formula = _
"=SUM(" & _
strCurrentColumn & _
lngRowToStartOn & ":" & _
strCurrentColumn & lngMaxRow - 1 & _
")"

'walk up the column and grab the number format
'from the last non-blank cell:
'if objExcel.ActiveCell.Value
Y = lngMaxRow
Do
Y = Y - 1
If IsNull(objExcel.ActiveSheet.Cells(Y, x).Value) = _
False Then
If objExcel.ActiveSheet.Cells(Y, x).Value "" Then
If objExcel.ActiveSheet.Cells(Y, x).Value _
0 Then Exit Do
End If
End If
Loop While Y lngRowToStartOn
If Y = lngRowToStartOn Then
If objExcel.ActiveSheet.Cells(Y, x).NumberFormat _
"@" Then
If objExcel.ActiveSheet.Cells(Y, x).NumberFormat =
"General" Then
objExcel.ActiveCell.NumberFormat = _
"#,##0_);-#,##0"
Else
objExcel.ActiveCell.NumberFormat = _
objExcel.ActiveSheet.Cells(Y, x).NumberFormat
If objExcel.ActiveCell.NumberFormat = _
"m/d/yyyy" Then
' can't calculate totals on a date field!
objExcel.ActiveCell.Formula = ""
End If
End If
Else
objExcel.ActiveCell.NumberFormat = _
"#,##0_);-#,##0" '"General"
End If
If Not IsNull(objExcel.ActiveCell.Value) Then _
If objExcel.ActiveCell.Value = 0 Then _
objExcel.ActiveCell.Formula = ""
Else
' if nothing was found, blank out the sum.
objExcel.ActiveCell.Formula = ""
End If
Next
DoEvents
If ColumnToPutTotalsWordIn 0 Then
strRange = LongToExcelColumnLetter(ColumnToPutTotalsWordIn) &
lngMaxRow
objExcel.Range(strRange).Select
objExcel.Range(strRange).Activate
' make sure cell will accept text
objExcel.Selection.NumberFormat = "@"
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
objExcel.ActiveCell = strTotalsWording
End If
End Sub
'---------------------------------------------------------------------
Sub AddTotalsColumn(objExcel As Object, _
Optional lngStartRow As Long = 1, _
Optional lngEndRow As Long = -1, _
Optional lngTotalsStartColumn As Long = -1, _
Optional lngTotalsEndColumn As Long = -1, _
Optional strColumnHeading As String = "Totals", _
Optional bolShadeColumn As Boolean = True)

Dim lngColumnToStartOn As Long
Dim lngColumnToEndOn As Long
Dim strColumnToStartOn As String
Dim strColumnToEndOn As String
Dim lngRowToEndOn As Long
Dim lngMaxColumn As Long
Dim strMaxColumn As String
Dim lngMaxRow As Long
Dim strRange As String
Dim strCurrentColumn As String
Dim x As Long

lngMaxRow = objExcel.Cells.SpecialCells(11).Row
lngMaxColumn = objExcel.Cells.SpecialCells(11).Column + 1
' The +1 above is to make a new max column
strMaxColumn = LongToExcelColumnLetter(lngMaxColumn)
' select entire column
objExcel.Columns(strMaxColumn & ":" & strMaxColumn).Select
' shift cells to the right
objExcel.Selection.Insert Shift:=-4161 'xlToRight

' Color the area and set font to bold:
strRange = strMaxColumn & "1:" & strMaxColumn & lngMaxRow
objExcel.Range(strRange).Select
If bolShadeColumn = True Then
objExcel.Selection.Interior.ColorIndex = 15
objExcel.Selection.Interior.Pattern = 1 'xlSolid
End If
objExcel.Selection.Font.Bold = True
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
objExcel.Selection.VerticalAlignment = -4107 'xlBottom
objExcel.Selection.WrapText = False
objExcel.Selection.Orientation = 0
objExcel.Selection.AddIndent = False
objExcel.Selection.IndentLevel = 0
objExcel.Selection.ShrinkToFit = False
objExcel.Selection.ReadingOrder = -5002 'xlContext
objExcel.Selection.MergeCells = False

If lngEndRow = -1 Then
lngRowToEndOn = lngMaxRow
End If
If lngEndRow lngMaxRow Then
lngRowToEndOn = lngMaxRow
End If

lngColumnToStartOn = lngTotalsStartColumn
lngColumnToEndOn = lngTotalsEndColumn
If lngTotalsStartColumn = -1 Then
lngColumnToStartOn = lngMaxColumn - 1
End If
If lngTotalsEndColumn = -1 Then
lngColumnToEndOn = lngMaxColumn - 1
End If

strColumnToStartOn = LongToExcelColumnLetter(lngColumnToStartOn)
strColumnToEndOn = LongToExcelColumnLetter(lngColumnToEndOn)

For x = lngStartRow To lngRowToEndOn
strRange = strMaxColumn & x
objExcel.Range(strRange).Activate
objExcel.ActiveCell.Formula = _
"=SUM(" & _
strColumnToStartOn & x & _
":" & _
strColumnToEndOn & x & _
")"
If objExcel.ActiveCell.NumberFormat = _
"$#,##0.00_);($#,##0.00)" Then
objExcel.Selection.HorizontalAlignment = -4152 'xlRight
End If
DoEvents
Next

strRange = strMaxColumn & "1"
objExcel.Range(strRange).Select
objExcel.Range(strRange).Activate
' make sure cell will accept text
objExcel.Selection.NumberFormat = "@"
objExcel.Selection.HorizontalAlignment = -4108 'xlCenter
objExcel.ActiveCell = strColumnHeading
End Sub


--
Drive C: Error. (A)bort (R)etry (S)mack The Darned Thing