Per Steve:
I am using microsoft access to track pediatric patients in my clinic. I would
like the program to automatically assign a growth percentile to the height
and weight. Has anybody already done this so I don't have to re-invent the
wheel? Thanks.
I'm doing it for mutual fund returns.
I call MS Excel's PERCENTILE() function thusly:
--------------------------------------------------------------------------
WhateverField = Percentile_Excel(curKFactor, mCellVals_YTD)
Public Function Percentile_Excel(ByVal theKFactor As Double, ByRef
theValueArray() As Double) As Variant
8000 debugStackPush mModuleName & ": Percentile_Excel"
8001 On Error GoTo Percentile_Excel_err
' PURPOSE: To invoke MS Excel's "Percentile" function
' ACCEPTS: - "K" factor required by Percentile()
' - Pointer to array of Double values that will be fed to ' '
Percentile()
' RETURNS: Result of Excel.PercentRank calculation
8002 Dim myPercentile As Double
8003 If UBound(theValueArray) > 0 Then
8010 If Excel_Start(gExcelApp) = True Then
8012 myPercentile = gExcelApp.WorksheetFunction.Percentile(theValueArray,
theKFactor)
8013 Percentile_Excel = myPercentile
8019 End If
8990 Else
8991 Percentile_Excel = Null
8999 End If
Percentile_Excel_xit:
DebugStackPop
On Error Resume Next
Exit Function
Percentile_Excel_err:
BugAlert True, ""
Resume Percentile_Excel_xit
End Function
Public Function Excel_Start(ByRef theSS As Excel.Application) As Boolean
3000 debugStackPush mModuleName & ": Excel_Start: "
3001 On Error GoTo Excel_Start_err
' PURPOSE: - Start an instance of MS Excel or use an existing instance
' - Leave "theSS" pointing to the Excel Basic engine
' behind the newly-opened document
' ACCEPTS: - Pointer to the spreadsheet TB used by calling routine
' RETURNS: True/False depending on success
'
' NOTES: 1) We do not want to keep opening up new instances of Excel every
time this routine
' is called, so we do the "= Nothing" check to see if theSS has
already been set.
' OTHO the user may have closed that instance of Excel, leaving
theSS pointing to
' Neverneverland. Experimentation shows that an error 2753 is
generated in this case.
' Hence the error trap and the "userClosedExcel" switch.
'
'SAMPLE:
' ?SpreadSheetOpenExisting("D:\Dev\SEI\DataSource\BuySell.xls",
gExcelApp)
3002 Dim userClosedExcel As Long
Dim serverNotExist As Long
Dim okToProceed As Boolean
Const oleError = 2753
Const rpcServerUnavailable = -2147023174
Const remoteServerNotExist = 462
Const docAlreadyOpen = 1004
Excel_Start_loop:
' ---------------------------------------------------
' Create an instance of Excel
3010 If (theSS Is Nothing) Or (userClosedExcel = 1) Then
3011 Set theSS = CreateObject("Excel.Application")
'3012 With theSs
'3013 .Workbooks.Add
'3014 .ScreenUpdating = True
'3015 .Visible = True
'3016 End With
3019 End If
' ---------------------------------------------------
' Open up the spreadsheet
3999 Excel_Start = True
Excel_Start_xit:
DebugStackPop
On Error Resume Next
Exit Function
Excel_Start_err:
Select Case Err
Case 2772
MsgBox "Unable to locate Microsoft Excel program. Please notify your
administrator", 16, "Cannot Open MS Excel"
Resume Excel_Start_xit
Case oleError, rpcServerUnavailable
If userClosedExcel = 0 Then
userClosedExcel = userClosedExcel + 1
Resume Excel_Start_loop
Else
BugAlert True, "Unable to open MS Excel. Suspect user may have
closed existing instance."
Resume Excel_Start_xit
End If
Case remoteServerNotExist
If serverNotExist = 0 Then
serverNotExist = serverNotExist + 1
Set theSS = Nothing
Resume Excel_Start_loop
Else
BugAlert True, "Unable to open MS Excel. Suspect user may have
closed existing instance."
Resume Excel_Start_xit
End If
Case docAlreadyOpen
BugAlert True, ""
Case Else
BugAlert True, ""
Resume Excel_Start_xit
End Select
Resume Excel_Start_xit 'Shouldn't be needed, but just in case.....
End Function
