Pass formula to Excel spreadsheet

[Ian]

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.

 

[Chuck Grimsby]

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

 

[Ian]

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]

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.

 

[Guest]

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/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

 

[Chuck Grimsby]

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!* )

 

[Ian]

Thanks for the explanation, Tom.

--
Ian
--

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/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

 

[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]

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.

 

[Chuck Grimsby]

Well, first off your problem is that you're using Macros! *Grin!*

On the serious side, you need to create the excel file *first*, some
where on your hard drive, and then run the code against that file,
then send it. Any other order doesn't make a whole lot of sense.

I'm not sure what you mean by "sending a form". A form really is just
a "window" into a table, there's really nothing there to send
anywhere. You'll need to figure out what the underlying query that
populates that form is, and output that data as an Excel file.

Once it's a file on your hard drive you can use the code I posted
against that file, and then use Office Automation to email the Excel
file as a attachment via Outlook. There are a couple of other email
methods available if you don't have Outlook (the full version, not
"Outlook Express"), but I won't go into those unless I know you need
them.

If the source of the forms is a pre-exiting query, you can use the
function below to create the file. (As always, watch the word Wrap!):

Public Function ExportToExcelViaQuery(strFileName As String, _
strSheetName As String, _
strQueryTableName As String, _
Optional whatDB As DAO.Database = Nothing) _
As Long
' note: only works with querydef objects or tables!
Dim strSQLLocal As String
Dim bolISetTheDB As Boolean

On Error GoTo HandleErr
If whatDB Is Nothing Then
Set whatDB = CurrentDb()
bolISetTheDB = True
End If

strSQLLocal = "SELECT * INTO " & _
"[Excel 8.0;Database=" & _
strFileName & "].[" & _
strSheetName & "] " & _
"FROM " & strQueryTableName
whatDB.Execute strSQLLocal, dbFailOnError
ExportToExcelViaQuery = whatDB.RecordsAffected

ExitHere:
If bolISetTheDB = True Then Set whatDB = Nothing

Exit Function
HandleErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Function

 

[Ian]

Hi Chuck

I've been wading through your code and trying to get it to work the way I
want it to (ie summing the columns as required). I've managed to get it to
only total the columns I need in the new row and move the Totals: cell ,
though this was by changing lngStartColumn to 10 and ColumnToPutTotalsWordIn
to 9. Ideally I need to change this so that it detects the number of
columns, then only sums the last 2 in the new row.

The problem I'm having just now (and the solution to this might be related
to the issue above) is that the AddTotalsColumn only totals the last
original column and I need it to total the last 2, both of which are times
in hh:mm format. (I also need to change the format of the new row/column to
[hh]:mm to show values above 24hrs, but I think I might be able to figure
that out)

I'm confused by the -1 values for lngTotalsStartColumn & lngTotalsEndColumn
as I assumed (wrongly) that the -1 was relative to the total number of
columns and changed lngTotalsStartColumn to -2. Needless to say, this didn't
work.

Can you shed some light on this?

 

[Chuck Grimsby]

Both functions allow you to pass to it the values you need the
function to run with. No need to change them if you need something
different, just change the parameters you pass the to the function.
The -1 values are "default" values to use if you choose not to pass
any. Basically, the -1's mean "Use the First or Last Row or Column as
appropriate".


For example, if you wanted to use the AddTotalsColumn function to
total the last 2 columns (columns.. Oh, say G & H), you would do
something like:

Call AddTotalsColumn(objExcel, , , 7, 8)

or you could do:

Call AddTotalsColumn(objExcel, , , 7)

Since the default (Optional lngTotalsEndColumn As Long = -1) means
that it'll automatically go from column #7 (G) to whatever the last
column happens to be (the -1 meaning "last"). The code will figure
out what the last column is automatically.

If you wanted to total columns C, D & E, but not G & H, you could do:

Call AddTotalsColumn(objExcel, , , 3, 5)

If you want to pass the -1's feel free to do so, but it's not
(usually) required.

Does that make any sense?

As for totaling time, I don't think that's going to work. In both
Excel and Access, Date/Time fields are ment to be "Date/Time STAMPS".
In other words, they're ment to mark a specific point in time. Just
like a date stamp on a receipt or something. To total those kinds of
fields, you need to use the DateDiff function to find out the
"elapsed" time (usually expressed as minutes or seconds depending upon
how much accuracy you need), and left as an integer to total up.

Both of the functions I posted will handle time like that, but I can't
see how you would do something formatting it in "HH:MM" style with any
accuracy.

Hi Chuck

I've been wading through your code and trying to get it to work the way I
want it to (ie summing the columns as required). I've managed to get it to
only total the columns I need in the new row and move the Totals: cell ,
though this was by changing lngStartColumn to 10 and ColumnToPutTotalsWordIn
to 9. Ideally I need to change this so that it detects the number of
columns, then only sums the last 2 in the new row.

The problem I'm having just now (and the solution to this might be related
to the issue above) is that the AddTotalsColumn only totals the last
original column and I need it to total the last 2, both of which are times
in hh:mm format. (I also need to change the format of the new row/column to
[hh]:mm to show values above 24hrs, but I think I might be able to figure
that out)

I'm confused by the -1 values for lngTotalsStartColumn & lngTotalsEndColumn
as I assumed (wrongly) that the -1 was relative to the total number of
columns and changed lngTotalsStartColumn to -2. Needless to say, this didn't
work.

Can you shed some light on this?

--
Ian

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

 

[Ian]

Thanks Chuck.

I've figured out the calculation of the last 2 columns by editing the lines
strColumnToStartOn = LongToExcelColumnLetter(lngColumnToStartOn)
strColumnToEndOn = LongToExcelColumnLetter(lngColumnToEndOn)

to read
strColumnToStartOn = LongToExcelColumnLetter(lngMaxColumn - 2)
strColumnToEndOn = LongToExcelColumnLetter(lngMaxColumn - 1)

The formatting I got to work, by adding this line
objExcel.ActiveCell.NumberFormat = "[hh]:mm"
immediately after the creation of the column SUM formula in the new row, but
the "Else" condition in the formatting code after it reverted it to General
format.

Can you explain what this code is there for? I can understand the need to
check for date formatting so no calculation occurs on those columns, but why
do you see it as necessary to change everyting else to General format?

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

--
Ian
--

Both functions allow you to pass to it the values you need the
function to run with. No need to change them if you need something
different, just change the parameters you pass the to the function.
The -1 values are "default" values to use if you choose not to pass
any. Basically, the -1's mean "Use the First or Last Row or Column as
appropriate".


For example, if you wanted to use the AddTotalsColumn function to
total the last 2 columns (columns.. Oh, say G & H), you would do
something like:

Call AddTotalsColumn(objExcel, , , 7, 8)

or you could do:

Call AddTotalsColumn(objExcel, , , 7)

Since the default (Optional lngTotalsEndColumn As Long = -1) means
that it'll automatically go from column #7 (G) to whatever the last
column happens to be (the -1 meaning "last"). The code will figure
out what the last column is automatically.

If you wanted to total columns C, D & E, but not G & H, you could do:

Call AddTotalsColumn(objExcel, , , 3, 5)

If you want to pass the -1's feel free to do so, but it's not
(usually) required.

Does that make any sense?

As for totaling time, I don't think that's going to work. In both
Excel and Access, Date/Time fields are ment to be "Date/Time STAMPS".
In other words, they're ment to mark a specific point in time. Just
like a date stamp on a receipt or something. To total those kinds of
fields, you need to use the DateDiff function to find out the
"elapsed" time (usually expressed as minutes or seconds depending upon
how much accuracy you need), and left as an integer to total up.

Both of the functions I posted will handle time like that, but I can't
see how you would do something formatting it in "HH:MM" style with any
accuracy.

Hi Chuck

I've been wading through your code and trying to get it to work the way I
want it to (ie summing the columns as required). I've managed to get it to
only total the columns I need in the new row and move the Totals: cell ,
though this was by changing lngStartColumn to 10 and
ColumnToPutTotalsWordIn
to 9. Ideally I need to change this so that it detects the number of
columns, then only sums the last 2 in the new row.

The problem I'm having just now (and the solution to this might be related
to the issue above) is that the AddTotalsColumn only totals the last
original column and I need it to total the last 2, both of which are times
in hh:mm format. (I also need to change the format of the new row/column
to
[hh]:mm to show values above 24hrs, but I think I might be able to figure
that out)

I'm confused by the -1 values for lngTotalsStartColumn &
lngTotalsEndColumn
as I assumed (wrongly) that the -1 was relative to the total number of
columns and changed lngTotalsStartColumn to -2. Needless to say, this
didn't
work.

Can you shed some light on this?

--
Ian

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

 

[Chuck Grimsby]

"@" is the format for text. So if the field is not text, I want to
give it _some_ format, and general just seems to work in most cases
for me (It's what Excel defaults to anyways).

 

[Ian]

Actually Tom, Outlook Express is keeping these messages together on my PC as
I have the option "Group Messages by Conversation" selected under
"View>Current View", though this may not apply to other newsreaders.
However, as this is effectively a different thread.....

 

[Ian]

Hi Tom

I can't argue with the gif image, but with the same settings the
conversation flows from one subject to the next. The only difference I can
see is that I have the conversation marked as watched. Perhaps that makes
the difference.

 

[Douglas J. Steele]

Outlook Express does continue to thread everything together even if the
subject is changed. However, if you tell OE to Show All Message, all you'll
see is the original thread name as the root of the thread.

Once the thread diverges, though, if you have OE set to Hide Read Messages,
then they'll show up in your reader as multiple threads.

The problem here was that the divergence happened on January 9th to a thread
that was started on December 29th. I marked the "Question along the same
lines" post as unread once I'd marked everything else as read, changed the
view to Show All Messages and tried to find the original thread ("Pass
formula to Excel spreadsheet"). I obviously didn't scroll back far enough: a
week and a half in this newsgroup is a lot of messages! (I did scroll back
far enough this time, and now have a screen shot showing both subjects in
the same thread if you're interested, Tom)

I wonder whether Daniel ever reposted to get his tag-along question answered
or not... <g>

 

[Guest]

Hi Daniel,

I have a excel sheet that we print out and then fill in by hand.

Fill what out by hand?

Only 4 fields need to be filled in. Name, Number, Phone, and fax and the
total number at any one time won't be more than 50 or so. So my recordset
will be small.

I assume you are referring to the total number or rows (records) in the
Excel spreadsheet. Is this correct? Presumably the data is exported from
your Access application. In any case, this doesn't sound like a problem.

I hoping keep that file the same and have it simply spit out the 4 fields to the
spreadsheet print it and then do the same time over again until all are finished.

Ummm....is there any reason that you cannot export all records in one
operation?

right now i've created an image of the spreadsheet and made it fit into a
report and placed the fields on that image.

Why are you doing this image processing? That sounds like a LOT of extra
work. Can you not simply create a nice formatted report in Access and print
it directly?



Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

Tom,

Sorry about the subject change, however, i'm not using outlook express and using a website called eggheadcafe.com and it doesn't copy over the subject when posting a reply. I also didn't see the two replies that asked what I was talking about.

Thanks for the answer I'll see how I can make that work. I'll go into a bit more detail so maybe you'll understand. I have a excel sheet that we print out and then fill in by hand. Only 4 fields need to be filled in. Name, Number, Phone, and fax and the total number at any one time won't be more than 50 or so. So my recordset will be small. I hoping keep that file the same and have it simply spit out the 4 fields to the spreadsheet print it and then do the same time over again until all are finished. It doesn't have to be in that order. right now i've created an image of the spreadsheet and made it fit into a report and placed the fields on that image. this is working, however, the acutal spreadsheet is larger and excel does a better job of shrinking it to fit one page vs making it smaller in an image editing program. Plus if I need to redo the spreadsheet in the future having it use the acutal file is much simpler to edit later rather than coming home redoing the mde

and taking it back to work as I can do the excel editing at work. Access 2003 is what is being used. If you need anything else let me know and thanks again for the answer.