Autosum is sample utility developed to emulate excel autosum - when you select
range of cells their sum, average, minimum, maximum or count is displayed in
right bottom corner.
When working with MS Access tables, querys and forms in datasheet view it is
sometimes necessary to know the sum of certain cells. Common solution is to
copy required cells, open MS Excel, paste and perform the calculations. Autosum
project installs as MS Access Add-In and adds some functionality to datasheet
context menus. You select cells, right-click and choose function (sum, average
e t.c) and operation result appears in office assistant baloon.
What is it for?
Autosum may be used as saving time utility for people working with access tables.
However most of use is illustrative. Examining code could help in:
a) Creating Access Add-ins
b) Creating custom menus (including context menus) programmatically
c) Working with Datasheet as with form
d) Working with recordsets
e) Working with office Assistant
Downloading
To download file press here. If you for some reasons
can not download it, you can create it yourself as described below.
To create Autosum open MS Access, create new database named AutoSumEng.mda.
Create two modules within it named AS and IN.
Copy code from this page to respective module.
Create a table named USysRegInfo with fields:
SubKey - Text 255
Type - Long Integer
ValName - Text 255
Value - Text 255
and fill them with following values:
SubKey
Type
ValName
Value
HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\&AutoSum
HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\&AutoSum
1
Expression
=Install()
HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\&AutoSum
1
Library
|ACCDIR\AutosumEng.mda
Your autosum is ready to install.
Installation
Autosum installs as Add-In. To install Autosum, first download it and save
to local disk. Then open any database (not Autosum) and choose Tools->Add-Ins->Add-In
Manager ->> Add New and point to path, where you saved AutoSum to. After
that, Add-In manager will copy Autosum to Access directory and you will not
need file on the disk where you originaly saved it to. You need to perform installation
only once. To uninstall Autosum use Uninstall option in Tools -> Add-Ins
-> Add-In Manager.
Using
Once installed, you can use autosum with all Access databases on your machine.
To start Autosum you need to press Tools -> Add-Ins -> AutoSum. AutoSum
functions will be available in context menus until you close database.
To use Autosum you need to open table or query and select range of cells (you
can select whole row or column or some rows or columns). Right-click and you
will see additional menu items: sum, average, count, countnum, min, max and
share. Click on function you want and you will get the result on the pop-up
assistant baloon. Click anywhere on the screen and assistant will disappear.
"Share" is function to calculate and display the share of each cell
of sum of all cells selected.
Known Problems
Autosum is non-commercial project and distributed free. All responsibility
for it's use rests on user. There are some known problems.
1) During installation Autosum sets the reference to it's functions library.
Any database, within wich Autosum add-in started, has the references to Autosum
library. If that database will be moved to another machine where there is no
Autosum installed, error may occur, caused by missed library. Solution to this
problem is to remove references to Autosum library before or after moving (Choosing
Tools -> References --> uncheck Autosum). That error is harmless to database,
but difficuilt to find - since error message will point to one of standard functions
(Date, Format, e t.c...) saying that access can't find project or library.
2) Autosum tested on WinNT 4.0 machine with Access 97. Other combinations are
not tested, however no problems expected.
3) Autosum may work incorrect with crosstab querys, since they have different
structure.
4) On large tables (up to 30000 records) summing up will take time. This process
can be optimized, but currently it may take some minutes.
5) Since office assistant used to display the result, if it is not installed,
you'll have no result displayed.
6) CountNum and Average functions works slightly different from excel. If value
of some cell can be interpreted as numeric it will be counted and ased in average,
regardless to field format. For example if in text field stored "1"
it will be counted.
Author will gladly accept any more bug reports and solutions for them.
Modules Code
In module:
This module is to install command bar buttons. Install is entry procedure.
Option Compare Database
Public Function Install()
On Error Resume Next
Dim a, b, c, d As Variant
Dim i, j As Integer
a = Array("Table Design Datasheet Cell", "Table Design
Datasheet Row", "Table Design Datasheet Column", "Query
Design Datasheet Cell", "Query Design Datasheet Row", "Query
Design Datasheet Column")
b = Array("Sum", "Average", "Count", "CountNum",
"Min", "Max", "Share")
c = Array("=umma()", "=verage()", "=ount()",
"=ountnums()", "=iiin()", "=aaax()", "=are()")
d = Array(226, 43, 12, 11, 172, 141, 5)
Function ExistMenu(menu As Variant, Caption As Variant)
Dim i As Integer
For i = 1 To Application.CommandBars(menu).Controls.Count
If Application.CommandBars(menu).Controls(i).Caption = Caption Then ExistMenu
= i: Exit Function
Next i
ExistMenu = False
End Function
Sub uninstall(a As Variant, b As Variant)
Dim i, j As Integer
For i = 0 To UBound(a)
For j = 0 To UBound(b)
If ExistMenu(a(i), b(j)) Then Application.CommandBars(a(i)).Controls(b(j)).Delete
Next j
Next i
End Sub
AS module.
This is module with functions, required to calculate and display values.
Option Compare Database
Public Function umma()
On Error Resume Next
Dim i, j, k, w, h As Long
Dim co(256) As Variant
Dim s As Double
Dim x As Object
Dim z, y As Variant
Set x = Application.Screen.ActiveControl.Parent
If x Is Nothing Then z = SysCmd(acSysCmdClearStatus): Exit Function
For k = 0 To x.Count
co(k) = x(k).ColumnOrder
Next k
w = IIf(x.SelWidth = 0, 0, x.SelWidth - 1)
h = x.SelHeight - 1
x.RecordsetClone.MoveFirst
y = GetR(x.RecordsetClone, x.SelTop + x.SelHeight)
s = 0
For i = x.SelLeft To x.SelLeft + w
For j = x.SelTop To x.SelTop + h
s = s + y(Transpose(co, i), j - 1)
Next j
Next i
On Error Resume Next
Dim i, j, k, w, h, q As Long
Dim co(256) As Variant
Dim s As Double
Dim x As Object
Dim z, y As Variant
Dim rst As Recordset
Set x = Application.Screen.ActiveControl.Parent
If x Is Nothing Then Exit Function
For k = 0 To x.Count
co(k) = x(k).ColumnOrder
Next k
w = IIf(x.SelWidth = 0, 0, x.SelWidth - 1)
h = x.SelHeight - 1
x.RecordsetClone.MoveFirst
y = GetR(x.RecordsetClone, x.SelTop + x.SelHeight)
q = x.RecordsetClone.RecordCount
k = 0
s = 0
For i = x.SelLeft To x.SelLeft + w
For j = x.SelTop To x.SelTop + h
If j <= q Then
If IsNumeric(y(Transpose(co, i), j - 1)) Then s = s + y(Transpose(co,
i), j - 1): k = k + 1
End If
Next j
Next i
Assistant.Visible = False
Set x = Nothing
Set rst = Nothing
End Function
Public Function aaax()
On Error Resume Next
Dim i, j, k, w, h As Long
Dim co(256) As Variant
Dim s As Double
Dim x As Object
Dim z, y As Variant
Dim rst As Recordset
Set x = Application.Screen.ActiveControl.Parent
If x Is Nothing Then Exit Function
For k = 0 To x.Count
co(k) = x(k).ColumnOrder
Next k
w = IIf(x.SelWidth = 0, 0, x.SelWidth - 1)
h = x.SelHeight - 1
x.RecordsetClone.MoveFirst
y = GetR(x.RecordsetClone, x.SelTop + x.SelHeight)
k = 0
s = y(Transpose(co, x.SelLeft), x.SelTop - 1)
For i = x.SelLeft To x.SelLeft + w
For j = x.SelTop To x.SelTop + h
If s < y(Transpose(co, i), j - 1) Then s = y(Transpose(co, i), j -
1)
Next j
Next i
Function Transpose(vararr As Variant, ByVal k As Long) As Long
Dim i As Long
For i = LBound(vararr) To UBound(vararr)
If vararr(i) = k Then Transpose = i: Exit Function
Next i
End Function
Public Function are()
On Error Resume Next
Dim i, j, k, w, h As Long
Dim co(256) As Variant
Dim text, u, subtotal As String
Dim s, st(256) As Double
Dim x As Object
Dim z, y As Variant
Set x = Application.Screen.ActiveControl.Parent
If x Is Nothing Then z = SysCmd(acSysCmdClearStatus): Exit Function
For k = 0 To x.Count
co(k) = x(k).ColumnOrder
Next k
w = IIf(x.SelWidth = 0, 0, x.SelWidth - 1)
h = x.SelHeight - 1
If h > 35 Then
text = "Sorry, i cand display on the screen so much rows at one time..."
Else
x.RecordsetClone.MoveFirst
y = GetR(x.RecordsetClone, x.SelTop + x.SelHeight)
s = 0
For i = x.SelLeft To x.SelLeft + w
For j = x.SelTop To x.SelTop + h
s = s + y(Transpose(co, i), j - 1)
st(i) = st(i) + y(Transpose(co, i), j - 1)
Next j
Next i
text = ""
For j = x.SelTop To x.SelTop + h
For i = x.SelLeft To x.SelLeft + w
u = Format(y(Transpose(co, i), j - 1) / s * 100, "00.00") &
"%"
text = text + " " + IIf(IsNumeric(y(Transpose(co, i), j - 1)),
u, Space(11)) + IIf(w > 0, "|", "")
Next i
text = text + Chr(10)
Next j
For i = x.SelLeft To x.SelLeft + w
u = Format(st(i) / s * 100, "00.00") & "%"
subtotal = subtotal + " " + IIf(st(i) <> 0, u, Space(11))
+ IIf(w > 0, "|", "")
Next i
text = text + "Subtotal:" + Chr(10) + "---" + Chr(10)
+ subtotal
End If
Assistant.Visible = True
With Assistant.NewBalloon
.BalloonType = msoModeModeless
.Mode = msoModeAutoDown
.Heading = "Shares:" & Chr(10) & "---"
.text = text
.Show
End With
Assistant.Visible = False
Set x = Nothing
Set rst = Nothing
End Function
Function GetR(rs As Recordset, n As Long) As Variant
Dim a, b As Variant
Dim i, j, l As Long
On Error Resume Next
l = rs.Fields.Count
ReDim a(l - 1, n - 1)
For j = 0 To n - 1
For i = 0 To l
a(i, j) = rs.Fields(i).Value
Next i
rs.MoveNext
Next j
GetR = a
End Function
How does that work? Comments on Code.
Here i will comment the setting up procedure and one of the functions (sum
calculation). All other functions work similarly.
Install
First of all i create 4 arrays (a,b,c,d)
Array a contains list of menu names to which new buttons are added.
b array contains captions to buttons.
c array contains names of functions corresponding to each button.
d array contains codes for icons displayed near buttons. Full list of codes
and pictures you can find here.
later goes reference to functions library.
SysCmd(acSysCmdAccessDir) returns MS access directory and
dir(codedb.Name) returns name of database.
Then i call uninstall in case of occasional starting install twice. I first
remove all the buttons listed in arrays and then install.
After uninstalling possible present buttons i cycle thru command bars and add
to each all the controls.
ExistMenu checks is there already a control with certain caption and, if not,
adds one:
Detailed description of syntax can be found in built-in help. Notice only one
thing - [Temporary] argument set to True. This determines that after closing
current database all the buttons will be automatically removed.
Then i set the OnAction, Caption and FaceID properties of this control to values
from corresponding arrays.
BeginGroup property determines the horizontal divider - i set it to true for
first element (j=0)
That's all about install.
Functions
I will comment one function, umma (i crop the first letter of summa to avoid
possible name conflict) - all others are the same.
Key string here is:
Set x = Application.Screen.ActiveControl.Parent
Trick is then you call function from context menu, active control is cell or
range of cells, and it's parent is datasheet. If you insert STOP statement after
that string and examine closely the x variable, you'll find very interesting
things. For example, that the inner representation of query result or table
datasheet view is datasheet/form named something like IT_Table1. This may lead
to interesting conclusions, for example you may set the OnTimer value for this
form and that will work- some user function will be called each n'th second
to the table.
However we need to use recordsetclone and SelWidth, SelTop, SelHeight, SelLeft
property of that form, which shows us the user selected region bounds.
I put the recordset clone to the array and perform computations.
Few tricks remains here: first, as i mentioned in Ways
to transfer MS Access data to Excel, DAO recordset has some problems with
GetRows method - if there are errors in recordset, it cuts the rows and returns
no error message. So i had to use special function (GetR) to transfer recordset
to array avoiding errors. That function slows the whole process, and modifying
it is the way to improve performance.
Second important thing: user can manually change column order (drag third column
to first), so the SelLeft property will show first column, however recordset
clone fields order remains the same, and i will show wrong number to user..
To avoid that problem, i first read the column orders to an array:
For k = 0 To x.Count
co(k) = x(k).ColumnOrder
Next k
And later use transpose function to point the recordset field index by column
order.
Here is main cycle, where sum (s) is computed:
s = 0
For i = x.SelLeft To x.SelLeft + w
For j = x.SelTop To x.SelTop + h
s = s + y(Transpose(co, i), j - 1)
Next j
Next i
That used to display result in office assistant baloon:
As you may see, many problems left. Much things has to be optimized, for example
when user clicks on column and summing it, thats no reason to move recordset
to array and sum, even the dlookup will be faster. Another big problem - how
to remove reference to library after database is closed. I will gladly accept
any help and improvements and hope that my work will be of use to somebody.