Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modified McCauley Duration From VBA?
Typed into a cell, this works:
=MDURATION("1/1/2008", "1/1/2016", ".08", ".09", "2", "1") But I want to invoke the calc from afar (specifically MS Access VBA). I can instantiate a copy of Excel, and invoke other routines like "MIN", but am not having any luck with "MDURATION" and, indeed, it does not appear in the code completion dropdown for WorksheetFunction.mDuration Sounds like I'm out of luck. Or am I? For the maschocistically inclined, here's the offending code (which looks it's best rendered in a monospaced font) - but all I really want to know is whether or not I can call MDURATION from VBA code and, if so, what the syntax would be.... -------------------------------------------------------------------------------------------------- Public Function MDURATION_Excel(ByVal theValues As String) As Variant 8000 debugStackPush mModuleName & ": MDURATION_Excel" 8001 On Error GoTo MDURATION_Excel_err ' PURPOSE: To invoke MS Excel's "MDURATION" (Modified McCauley duration) function" ' ACCEPTS: A list of values as a string delimintated by commas ' The values a ' - Settlement Date ' - Maturity Date ' - Coupon percent ' - Yield percent ' - Payment Frequency ' 0 = 3./360 ' 1 = Actual/Actual ' 2 = Actual/360 ' 3 = Actual/365 ' 4 = European 30/360 ' RETURNS: Result of Excel.MDURATION calculation ' ' SAMPLE: ' ----------------------------------------- ' MS Excel's Help e.g. ' =MDURATION("1/1/2008", "1/1/2016", ".08", ".09", "2", "1") ' 5.73567 ' translated to call syntax for this routine: ' ?MDURATION_Excel("1/1/2008, 1/1/2016, .08, .09, 2, 1") 8002 Dim myArray() As String Dim i As Long Dim myResult As Double 8003 If Len(theValues) 0 Then 8010 If Excel_Start(gExcelApp) = True Then 8011 ParseToArrayOfString theValues, ",", myArray 'Put values in format acceptable to Excel 8912 myResult = gExcelApp.WorksheetFunction.mDuration(myArray) 8913 MDURATION_Excel = myResult 8919 End If 8990 Else 8991 MDURATION_Excel = "na" 8999 End If MDURATION_Excel_xit: DebugStackPop On Error Resume Next Exit Function MDURATION_Excel_err: BugAlert True, "" Resume MDURATION_Excel_xit End Function Public Function ParseToArrayOfString(ByVal theStringToBeParsed As String, ByVal theDelimiter As String, ByRef theArray() As String) As Long 1000 debugStackPush mModuleName & ": ParseToArrayOfString" 1001 On Error GoTo ParseToArrayOfString_err ' PURPOSE: To parse a Delimited string into an array ' ACCEPTS: - String to be parsed ' - Delimiter between items in the string ' - Address of the array that results will be delivered to ' RETURNS: The number of items copied to the array or -1 ' SETS: The contents of the array specified ' ' CALLING CONVENTION: ' ReDim Items(20) ' ItemCount = ParseToArrayOfString("this, is, a string, delimited, by, commas",Items(),",") 1003 Dim P As Integer Dim i As Integer Dim newSize As Integer Const textComparison = 1 1010 If Len(theStringToBeParsed & "") 0 Then 1020 If theDelimiter = "" Then 'Check for valid theDelimiteriter 1030 ParseToArrayOfString = -1 1040 Else 1041 If Len(theStringToBeParsed) < 1 Then 1042 ParseToArrayOfString = -1 1043 Else 1050 i = 0 1060 P = InStr(1, theStringToBeParsed, theDelimiter, textComparison) 1061 If P = 0 Then 'Oops! Only one item, no delimiter 1062 i = 1 1063 ReDim Preserve theArray(i) 1064 theArray(0) = theStringToBeParsed 1065 Else 1070 Do While P 0 'Copy all items except last 1080 newSize = i + 1 1090 ReDim Preserve theArray(newSize) 1100 theArray(LBound(theArray) + i) = Left$ (theStringToBeParsed, P - 1) 1110 i = i + 1 1120 theStringToBeParsed = Mid$(theStringToBeParsed, P + 1) 1130 P = InStr(1, theStringToBeParsed, theDelimiter, textComparison) 1140 Loop 1150 theArray(LBound(theArray) + i) = theStringToBeParsed 'Copy Last Item 1160 i = i + 1 1165 End If 1170 ParseToArrayOfString = i 1997 End If 1998 End If 1999 End If ParseToArrayOfString_xit: DebugStackPop On Error Resume Next Exit Function ParseToArrayOfString_err: ParseToArrayOfString = -1 BugAlert True, "" Resume ParseToArrayOfString_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 -------------------------------------------------------------------------------------------------- |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modified McCauley Duration From VBA?
I can instantiate a copy of Excel, and invoke other routines like
"MIN", but am not having any luck with "MDURATION" and, indeed, it does not appear in the code completion dropdown for WorksheetFunction.mDuration Sounds like I'm out of luck. Needless to say, I still have the option of pushing a formula into a cell, pushing the arguments into other cells, excuting the formula cell, and then picking off the result. But that seems wrong somehow.... at least if there's a direct route via .WorkSheetFunction... |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modified McCauley Duration From VBA?
Needless to say, I still have the option of pushing a formula into a
cell, pushing the arguments into other cells, excuting the formula cell, and then picking off the result. When I go that way, however, it still throws an error. I come up with a FormulaR1C1 of something like: =MDURATION("1/1/2008", "1/1/2016", ".08", ".09", "2", "1") And, indeed, when I manually paste that into a spreadsheet that I have created by opening up Excel manually, I get the expected result. But when I programatically put it into a spreadsheet I have opened via code, it gives an "Error 2029". If I copy the exact formula the code has created from the cell it was created into and paste that into another sheet, it works too. Can anybody elucidate? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
duration | Excel Worksheet Functions | |||
fx duration | Excel Worksheet Functions | |||
Modified Duration | Excel Worksheet Functions | |||
Duration | Excel Discussion (Misc queries) | |||
Duration | Excel Discussion (Misc queries) |