'=================
' local constants
'=================
' table constants
Const RANGE_HEADER = "A6:M6"
' contract description
Const COLUMN_SYMBOL = "A"
Const COLUMN_SECTYPE = "B"
Const COLUMN_EXPIRY = "C"
Const COLUMN_STRIKE = "D"
Const COLUMN_RIGHT = "E"
Const COLUMN_MULTIPLIER = "F"
Const COLUMN_EXCH = "G"
Const COLUMN_PRIMEXCH = "H"
Const COLUMN_CURRENCY = "I"
Const COLUMN_LOCALSYMBOL = "J"
Const COLUMN_COMBOLEGS = "K"
Const COLUMN_UNDERCOMP = "L"
Const COLUMN_INCLUDEEXPIRED = "M"
Const COLUMN_STATUS = "N"
' query specification
Const COLUMN_ENDDATETIME = "O"
Const COLUMN_DURATION = "P"
Const COLUMN_BARSIZE = "Q"
Const COLUMN_WHATTOSHOW = "R"
Const COLUMN_RTHONLY = "S"
Const COLUMN_DATEFORMAT = "T"
Const COLUMN_SHEETNAME = "U"
Const COLUMN_ACTIVATESHEET = "V"
'==============
' methods
'==============
' create ticker
Private Sub CreateTicker_Click()
TickerForm.Show
End Sub
' create combo legs
Private Sub ComboLegs_Click()
ComboLegForm.ShowForm (RANGE_HEADER)
End Sub
' cancel historical data
Private Sub CancelHistoricalData_Click()
If Not (objTWSControl Is Nothing) Then
If objTWSControl.m_isConnected Then
Dim id As Integer
id = ActiveCell.row
Call objTWSControl.m_TWSControl.CancelHistoricalData(id + ID_HISTDATA)
Cells(id, Columns(COLUMN_STATUS).column).value = STR_CANCELLED
ActiveCell.Offset(1, 0).Activate
Else
MsgBox (STR_TWS_CONTROL_NOT_CONNECTED)
End If
Else
MsgBox (STR_TWS_CONTROL_NOT_INITIALIZED)
End If
End Sub
' request historical data
Public Sub RequestHistoricalData_Click()
If Not (objTWSControl Is Nothing) Then
If objTWSControl.m_isConnected Then
Dim id As Long
id = ActiveCell.row
' create contract
Set objTWSControl.m_contractInfo = objTWSControl.m_TWSControl.createContract()
' fill contract structure
With objTWSControl.m_contractInfo
.symbol = UCase(Cells(id, Columns(COLUMN_SYMBOL).column).value)
.secType = UCase(Cells(id, Columns(COLUMN_SECTYPE).column).value)
.expiry = Cells(id, Columns(COLUMN_EXPIRY).column).value
.Strike = Cells(id, Columns(COLUMN_STRIKE).column).value
.Right = UCase(Cells(id, Columns(COLUMN_RIGHT).column).value)
.multiplier = UCase(Cells(id, Columns(COLUMN_MULTIPLIER).column).value)
.exchange = UCase(Cells(id, Columns(COLUMN_EXCH).column).value)
.primaryExchange = UCase(Cells(id, Columns(COLUMN_PRIMEXCH).column).value)
.currency = UCase(Cells(id, Columns(COLUMN_CURRENCY).column).value)
.localSymbol = UCase(Cells(id, Columns(COLUMN_LOCALSYMBOL).column).value)
.includeExpired = Cells(id, Columns(COLUMN_INCLUDEEXPIRED).column).value
End With
' combo legs
If Cells(id, Columns(COLUMN_SECTYPE).column).value = SECTYPE_BAG And _
Cells(id, Columns(COLUMN_COMBOLEGS).column) <> STR_EMPTY Then
' create combo leg list
objTWSControl.m_contractInfo.ComboLegs = objTWSControl.m_TWSControl.createComboLegList()
' parse combo legs string
Call Util.ParseComboLegsIntoStruct(Cells(id, Columns(COLUMN_COMBOLEGS).column).value, objTWSControl.m_contractInfo.ComboLegs)
End If
' under comp
If Cells(id, Columns(COLUMN_SECTYPE).column).value = SECTYPE_BAG And _
Cells(id, Columns(COLUMN_UNDERCOMP).column) <> STR_EMPTY Then
' create under comp
objTWSControl.m_contractInfo.underComp = objTWSControl.m_TWSControl.createUnderComp()
' parse under comp info
Call Util.ParseUnderCompIntoStruct(Cells(id, Columns(COLUMN_UNDERCOMP).column).value, objTWSControl.m_contractInfo.underComp)
End If
' query specification
Dim endDateTime As String, duration As String, barSize As String, whatToShow As String
Dim useRTH As Long
Dim formatDate As Long
endDateTime = STR_EMPTY
duration = STR_EMPTY
barSize = STR_EMPTY
whatToShow = STR_EMPTY
useRTH = True
formatDate = 1
If Cells(id, Columns(COLUMN_ENDDATETIME).column).value <> STR_EMPTY Then
endDateTime = UCase(Cells(id, Columns(COLUMN_ENDDATETIME).column).value)
Else
endDateTime = Format(Now, "YYYYMMDD HH:mm:SS") + " GMT"
End If
duration = UCase(Cells(id, Columns(COLUMN_DURATION).column).value)
barSize = Cells(id, Columns(COLUMN_BARSIZE).column).value
whatToShow = UCase(Cells(id, Columns(COLUMN_WHATTOSHOW).column).value)
useRTH = Cells(id, Columns(COLUMN_RTHONLY).column).value
formatDate = Cells(id, Columns(COLUMN_DATEFORMAT).column).value
' call reqHistoricalDataEx method
Call objTWSControl.m_TWSControl.reqHistoricalDataEx(id + ID_HISTDATA, objTWSControl.m_contractInfo, endDateTime, duration, barSize, whatToShow, useRTH, formatDate)
Cells(id, Columns(COLUMN_STATUS).column).value = STR_PROCESSING
ActiveCell.Offset(1, 0).Activate
Else
MsgBox (STR_TWS_CONTROL_NOT_CONNECTED)
End If
Else
MsgBox (STR_TWS_CONTROL_NOT_INITIALIZED)
End If
End Sub
' update historical data table
Public Sub UpdateHistoricalData(reqId As Long, histDate As String, histOpen As Double, histHigh As Double, histLow As Double, histClose As Double, histVolume As Long, barCount As Long, WAP As Double, hasGaps As Long)
reqId = reqId - ID_HISTDATA
Dim sheetName As String
sheetName = Cells(reqId, Columns(COLUMN_SHEETNAME).column).value
Dim newSheet As Worksheet
If sheetName <> STR_EMPTY Or Not IsNumeric(sheetName) Then
' add new sheet or get existed
addNewSheet (sheetName)
Set newSheet = ThisWorkbook.Sheets(sheetName)
ThisWorkbook.Sheets(SHEET_NAME_HISTDATA).Activate
End If
If histOpen > 0 Then
Dim newSheetRowId As Double
newSheetRowId = Val((Sheets(sheetName).Cells(1, 1).value))
newSheet.Cells(newSheetRowId, 1).value = histDate
newSheet.Cells(newSheetRowId, 2).value = histOpen
newSheet.Cells(newSheetRowId, 3).value = histHigh
newSheet.Cells(newSheetRowId, 4).value = histLow
newSheet.Cells(newSheetRowId, 5).value = histClose
newSheet.Cells(newSheetRowId, 6).value = histVolume
newSheet.Cells(newSheetRowId, 7).value = barCount
newSheet.Cells(newSheetRowId, 8).value = WAP
newSheet.Cells(newSheetRowId, 9).value = hasGaps
newSheet.Cells(1, 1).value = newSheetRowId + 1
Else
' finishing
newSheet.Cells(1, 1).value = 0
Cells(reqId, Columns(COLUMN_STATUS).column).value = STR_FINISHED
If Cells(reqId, Columns(COLUMN_ACTIVATESHEET).column).value Then
newSheet.Activate
End If
End If
End Sub
' this function finds sheet by name or adds new if sheet was not found
Private Sub addNewSheet(sheetName As String)
Dim addNewSheet As Boolean
addNewSheet = True
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name = sheetName Then
' sheet was found
addNewSheet = False
If ws.Cells(1, 1).value = 0 Or ws.Cells(1, 1).value = STR_EMPTY Then
ws.Cells.Clear
Call AddHeaderToNewSheet(ws)
End If
End If
Next
If addNewSheet Then
' sheet was not found
Sheets.Add Type:="Worksheet"
With ActiveSheet
.Move after:=Worksheets(Worksheets.Count)
.Name = sheetName
End With
Call AddHeaderToNewSheet(ActiveSheet)
End If
End Sub
Private Sub AddHeaderToNewSheet(newSheet As Worksheet)
newSheet.Cells(1, 1).value = 3
newSheet.Cells(2, 1).value = "Date/Time"
newSheet.Cells(2, 2).value = "Open"
newSheet.Cells(2, 3).value = "High"
newSheet.Cells(2, 4).value = "Low"
newSheet.Cells(2, 5).value = "Close"
newSheet.Cells(2, 6).value = "Volume"
newSheet.Cells(2, 7).value = "Count"
newSheet.Cells(2, 8).value = "WAP"
newSheet.Cells(2, 9).value = "HasGaps"
End Sub
Public Sub ProcessError(ByVal id As Long, ByVal errorCode As Long, ByVal errorMsg As String)
Cells(id - ID_HISTDATA, Columns(COLUMN_STATUS).column).value = STR_ERROR + STR_COLON + Str(errorCode) + STR_SPACE + errorMsg
End Sub
