Online Book Reader

Home Category

Access Cookbook - Ken Getz [257]

By Root 2121 0
specific Excel objects.

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

Return Main Page Previous Page Next Page

®Online Book Reader