Access Cookbook - Ken Getz [257]
To test the OLE communication between Access and Excel, load frmTestExcel from 12-03.MDB and click the button on the form to start the test. The code attached to the button will start up Excel and run a series of tests, calling Excel to retrieve the results for a number of function calls. After all the tests, the sample form will look like Figure 12-5. You can run the tests either by writing directly to spreadsheet cells to test the multiple-value functions or by using arrays. The checkbox on the form lets you try both methods.
Figure 12-5. frmTestExcel after its function calls are completed
The sample form tests two different types of function calls you can make to Excel from Access: functions that accept simple parameters, and functions that require multiple values (ranges) as parameters.
The following steps describe how set up the example form:
Create a new form containing a single text box (named txtResults on the sample form) and a command button to run the Excel tests (as in Figure 12-5).
Import the module basExcel from 12-03.MDB. This module contains a function that copies data from a column in Access to a spreadsheet column in Excel. The module also includes a function that copies data from a column in Access to an array, which OLE Automation can use in place of a range.
Enter the following code into the form's module (click on the Build button on the toolbar or choose View → Code):
Private Sub AddLine(strLabel As String, varValue As Variant)
Me.txtResults = Me.txtResults & vbCrLf & _
" " & Left(strLabel & Space(20), 20) & varValue
DoEvents
End Sub
Private Function TestExcel( )
Dim obj As Excel.Application
Dim intCount As Integer
Dim blnUseArrays As Boolean
Me.txtResults = Null
blnUseArrays = Nz(Me.chkUseArrays)
DoEvents
AddLine "Starting Excel:", "Please wait..."
' If you know Excel is open, you could use GetObject( )
Set obj = CreateObject("Excel.Application")
' Clear out the results text box.
Me.txtResults = Null
DoEvents
' String functions
AddLine "Proper:", obj.Proper("this is a test")
AddLine "Substitute:", obj.Substitute("abcdeabcdeabcde", "a", "*")
' Simple math functions
AddLine "Median:", obj.Median(1, 2, 3, 4, 5)
AddLine "Fact:", obj.Fact(10)
' Analytical functions
AddLine "Kurt:", obj.Kurt(3, 4, 5, 2, 3, 4, 5, 6, 4, 7)
AddLine "Skew:", obj.Skew(3, 4, 5, 2, 3, 4, 5, 6, 4, 7)
AddLine "VDB:", obj.VDB(2400, 300, 10, 0, 0.875, 1.5)
AddLine "SYD:", obj.SYD(30000, 7500, 10, 10)
If blnUseArrays Then
' Using arrays
Dim varCol1 As Variant
Dim varCol2 As Variant
' Copy two fields to columns
Call acbCopyColumnToArray(varCol1, "tblNumbers", "Number1")
Call acbCopyColumnToArray(varCol2, "tblNumbers", "Number2")
' Print out calculations based on those ranges
AddLine "SumX2PY2:", obj.SumX2PY2(varCol1, varCol2)
AddLine "SumSQ:", obj.SumSQ(varCol1)
AddLine "SumProduct:", obj.SumProduct(varCol1, varCol2)
AddLine "StDev:", obj.STDEV(varCol1)
AddLine "Forecast:", obj.ForeCast(5, varCol1, varCol2)
AddLine "Median:", obj.Median(varCol1)
Else
' Using ranges
Dim objBook As Workbook
Dim objSheet As Worksheet
Dim objRange1 As Range
Dim objRange2 As Range
' Create the workbook.
Set objBook = obj.Workbooks.Add
Set objSheet = objBook.WorkSheets(1)
' Copy two fields to columns
intCount = acbCopyColumnToSheet(objSheet, "tblNumbers", "Number1", 1)
intCount = acbCopyColumnToSheet(objSheet, "tblNumbers", "Number2", 2)
' Create ranges
Set objRange1 = objSheet.Range("A1:A" & intCount)
Set objRange2 = objSheet.Range("B1:B" & intCount)
' Print out calculations based on those ranges
AddLine "SumX2PY2:", obj.SumX2PY2(objRange1, objRange2)
AddLine "SumSQ:", obj.SumSQ(objRange1)
AddLine "SumProduct:", obj.SumProduct(objRange1, objRange2)
AddLine "StDev:", obj.STDEV(objRange1)
AddLine "Forecast:", obj.ForeCast(5, objRange1, objRange2)
AddLine "Median:", obj.Median(objRange1)
' Convince Excel that it needn't save that
' workbook you created.
obj.ActiveWorkbook.Saved = True
Set objRange1 = Nothing
Set objRange2