Advertisement
Advertisement
| 08.19.2008 at 02:36AM PDT, ID: 23658923 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: |
Private Sub SaveResultsToXls()
Dim myXL As Excel.Application = CreateObject("Excel.Application")
Dim oldCalc As Excel.XlCalculation
Dim wkBk As Excel.Workbook
Try
'Create a workbook in Excel and get range references
wkBk = myXL.Workbooks.Open(_PathToXlTemplate)
oldCalc = myXL.Calculation
Dim rng_ReportTitle As Excel.Range = myXL.Range("rng_ReportTitle")
Dim rng_OutputTitles As Excel.Range = myXL.Range("rng_OutputTitles")
myXL.Visible = False
myXL.DisplayAlerts = False
myXL.Calculation = Excel.XlCalculation.xlCalculationManual
myXL.ScreenUpdating = False
'Do titles
rng_ReportTitle.Value = "Open Interest Summary for " & _Indice & " as at " & AnlsysDt.ToString("ddd dd MMM yyyy", Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat)
'Present Summary Grid
Dim saod As ShareActivityOnDay
Dim etod As EtoDefinition
Dim rowCounter As Long
'Clear the data
Dim rowString As String
rowString = rng_OutputTitles.Row + 1 & ":" & 65536
rng_OutputTitles.Parent.Rows(rowString).ClearContents()
'Punch in the data
rowCounter = 1
For Each saod In ShareActivitiesOnDay.Values
For Each etod In saod.Etos.Values
rowCounter = rowCounter + 1
rng_OutputTitles(rowCounter, COL_Underlying).Value = saod.ShareCode
rng_OutputTitles(rowCounter, COL_Spot).Value = saod.AnlsysDt_ClsPrc
rng_OutputTitles(rowCounter, COL_ETOCode).Value = etod.EtoCode
If etod.IsPut Then
rng_OutputTitles(rowCounter, COL_PutCall).Value = "P"
Else
rng_OutputTitles(rowCounter, COL_PutCall).Value = "C"
End If
rng_OutputTitles(rowCounter, COL_ExpiryDate).Value = etod.ExpiryDate
rng_OutputTitles(rowCounter, COL_Strike).Value = etod.Strike
rng_OutputTitles(rowCounter, COL_UnderlyingAvgDailyVolume).Value = saod.AverageVolume_ShrAvergngPeriod
rng_OutputTitles(rowCounter, COL_OpenInterest).Value = etod.OpenInterest
rng_OutputTitles(rowCounter, COL_Moneyness).Value = GetMoneynessBucket(etod.IsPut, saod.AnlsysDt_ClsPrc, etod.Strike)
'rng_OutputTitles(rowCounter, COL_SharesPerContract).Value = etod.SharesPerContract
If saod.AverageVolume_ShrAvergngPeriod > 0 Then
rng_OutputTitles(rowCounter, COL_OpenIntDivAvgVolume).Value = (etod.SharesPerContract * etod.OpenInterest) / saod.AverageVolume_ShrAvergngPeriod
End If
Next etod
Next saod
'Turn off autofilter
If rng_OutputTitles.Parent.AutoFilterMode = True Then
rng_OutputTitles.Parent.AutoFilterMode = False
End If
'Sort the data
Dim sortRange As Excel.Range
sortRange = myXL.Range(rng_OutputTitles(2, 1), rng_OutputTitles(60000, rng_OutputTitles.Columns.Count))
sortRange.Sort(Key1:=rng_OutputTitles(2, COL_Underlying) _
, Order1:=Excel.XlSortOrder.xlAscending _
, Key2:=rng_OutputTitles(2, COL_PutCall) _
, Order2:=Excel.XlSortOrder.xlDescending _
, Key3:=rng_OutputTitles(2, COL_Strike) _
, Order3:=Excel.XlSortOrder.xlDescending _
, Header:=Excel.XlYesNoGuess.xlNo _
, Orientation:=Excel.XlSortOrientation.xlSortColumns)
'Turn on Autofilter
Dim filterRange As Excel.Range
filterRange = myXL.Range(rng_OutputTitles(1, 1), rng_OutputTitles(60000, rng_OutputTitles.Columns.Count))
'Annoyingly, one just cant go filterRange.Autofilter
filterRange.Parent.Select()
filterRange.Select()
myXL.Selection.Autofilter()
'Clean up
rng_OutputTitles.Parent.Activate()
myXL.Cells(1, 1).Select()
Catch ex As Exception
Throw New Exception("Could not save to excel", ex)
Finally
Try
wkBk.SaveAs(workbookPath)
Catch ex As Exception
End Try
Try
wkBk.Close(False)
Catch ex As Exception
End Try
Try
Dim junkbk As Excel.Workbook = myXL.Workbooks.Add
myXL.ScreenUpdating = True
myXL.Calculation = oldCalc
myXL.DisplayAlerts = True
junkbk.Close(False)
Catch ex As Exception
End Try
Try
myXL.Quit()
myXL = Nothing
wkBk = Nothing
GC.Collect()
Catch ex As Exception
End Try
End Try
End Sub
|