終於到最後一節了，這裡完整測試了登入、報價、記錄、出現訊號、送至下單匣並收取回報資料。
我把程式碼貼在影片下方，請先從頭依課程影片試著做做看，然後再來比對出入的地方。
程式碼
工作表1
Dim WithEvents skC As SKCOMLib.SKCenterLib
Dim WithEvents skQ As SKCOMLib.SKQuoteLib
Public strID As String, strPW As String
Private Sub btnQuote_Click()
'開始報價，清除報價、記錄、已送註記、下單匣
ThisWorkbook.Names("報價").RefersToRange.ClearContents
Names("訊號1").RefersToRange.Offset(1, 1).Resize(1048575, 1).ClearContents
ThisWorkbook.Names("記錄").RefersToRange.ClearContents
工作表2.[2:1048576].ClearContents
Dim strStock As String
Dim nPage As Integer, rt As Integer
nPage = 1
strStock = [a2]
For Each Rng In [a3:a91]
strStock = strStock & "," & Rng
Next
rt = skQ.SKQuoteLib_RequestStocks(nPage, strStock)
End Sub
Private Sub btnRecord_Click()
If Time <= #1:30:00 PM# Then
Names("記錄欄位").RefersToRange = WorksheetFunction.Match(CSng(Time) + 1 / 8640000, ThisWorkbook.Names("時間起點").RefersToRange.Resize(1, 5402), 1)
Application.OnTime Date + ThisWorkbook.Names("時間起點").RefersToRange.Offset(0, Names("記錄欄位").RefersToRange), "工作表1.Record"
End If
End Sub
Private Sub Record()
Dim intRows As Integer
Dim intC As Integer, intN As Integer
Dim rngStart As Range
Set rngStart = ThisWorkbook.Names("時間起點").RefersToRange
intC = Names("記錄欄位").RefersToRange.Value
intN = ThisWorkbook.Names("欄數").RefersToRange.Value
intRows = [a1048576].End(xlUp).Row - 1
rngStart.Offset(1, intC).Resize(intRows, 1).Value = [c2].Resize(intRows, 1).Value
'填前價與高低
If intC > intN Then
[n2].Resize(intRows, 1).Value = rngStart.Offset(1, intC - intN).Resize(intRows, 1).Value
For Each Rng In [o2].Resize(intRows, 1)
Rng.Value = WorksheetFunction.Max(rngStart.Offset(Rng.Row - 1, intC - intN).Resize(1, intN))
Rng.Offset(0, 1).Value = WorksheetFunction.Min(rngStart.Offset(Rng.Row - 1, intC - intN).Resize(1, intN))
Next
End If
'設定下次記錄時間
If rngStart.Offset(0, intC + 1) < TimeValue("13:30:00") Then
Application.OnTime rngStart.Offset(0, intC + 1), "工作表1.Record"
Names("記錄欄位").RefersToRange = intC + 1
End If
End Sub
Private Sub btnStopRecord_Click()
On Error Resume Next
Application.OnTime ThisWorkbook.Names("時間起點").RefersToRange.Offset(0, Names("記錄欄位").RefersToRange.Value), "工作表1.Record", , False
End Sub
Private Sub CommandButton1_Click()
If skC Is Nothing Then
Set skC = New SKCOMLib.SKCenterLib
Set skQ = New SKCOMLib.SKQuoteLib
Set 工作表3.skR = New SKCOMLib.SKReplyLib
Set 工作表2.skO = New SKCOMLib.SKOrderLib
End If
UserForm1.Show
Dim rt As Integer
rt = skC.SKCenterLib_Login(strID, strPW)
If rt = 0 Then
Call 工作表3.connect_reply
rt = 工作表2.Ini_Order()
rt = skQ.SKQuoteLib_EnterMonitor
Else
tbxR.Text = "下單失敗, rt=" & rt
End If
End Sub
Private Sub skQ_OnConnection(ByVal nKind As Long, ByVal nCode As Long)
Call addText(CStr(nKind))
End Sub
'新增通知訊息
Sub addText(strMsg As String)
tbxR.Text = strMsg & vbCrLf & tbxR.Text
End Sub
Private Sub skQ_OnNotifyQuote(ByVal sMarketNo As Integer, ByVal sStockIdx As Integer)
If Application.Ready Then
Dim st As SKCOMLib.SKSTOCK
Dim rt As Integer
rt = skQ.SKQuoteLib_GetStockByIndex(sMarketNo, sStockIdx, st)
Dim intRow As Integer
intRow = WorksheetFunction.Match(st.bstrStockNo, [a2:a91], 0)
Dim a(11)
a(0) = st.bstrStockName
a(1) = st.nClose / 10 ^ st.sDecimal
a(2) = st.nTQty
a(3) = st.nUp / 10 ^ st.sDecimal
a(4) = st.nDown / 10 ^ st.sDecimal
a(5) = st.nBid / 10 ^ st.sDecimal
a(6) = st.nBc
a(7) = st.nAsk / 10 ^ st.sDecimal
a(8) = st.nAc
a(9) = st.nHigh / 10 ^ st.sDecimal
a(10) = st.nLow / 10 ^ st.sDecimal
a(11) = st.nOpen / 10 ^ st.sDecimal
[a1].Offset(intRow, 1).Resize(1, 12) = a
'檢查訊號
Call checkSignal([a1].Offset(intRow - 1, 0))
End If
End Sub
'檢查訊號
Private Sub checkSignal(rngCode As Range)
If Names("訊號1").RefersToRange.Offset(rngCode.Row - 1) = "sell" Then
If Names("訊號1").RefersToRange.Offset(rngCode.Row - 1, 1) = "" Then
With 工作表2.[c1048576].End(xlUp).Offset(1, 0)
.Value = rngCode
.Offset(0, 1) = rngCode.Offset(0, 1)
.Offset(0, 2) = "S"
.Offset(0, 3) = rngCode.Offset(0, 4) '漲停賣出
.Offset(0, 4) = 1
.Offset(0, 16).Formula = "=" & rngCode.Offset(0, 2).Address(external:=True)
If cbxToOrder.Value Then
Call 工作表2.real_Order(.Cells(1, 1))
End If
End With
Names("訊號1").RefersToRange.Offset(rngCode.Row - 1, 1) = "訊號1"
Call 工作表3.RedoReply
End If
End If
End Sub
Private Sub skR_OnReplyMessage(ByVal bstrUserID As String, ByVal bstrMessage As String, sConfirmCode As Integer)
sConfirmCode = True
'MsgBox (bstrMessage)
End Sub
工作表2
Public WithEvents skO As SKCOMLib.SKOrderLib
Function Ini_Order() As Integer
Dim rt As Integer
rt = skO.SKOrderLib_Initialize
If rt = 0 Then
rt = skO.ReadCertByID(工作表1.strID)
End If
Ini_Order = rt
End Function
Sub test_Order()
Dim st As STOCKORDER
st = stock_order("6104", "65.5", 0, 0, 1)
Dim rt As Integer
Dim strMsg As String
rt = skO.SendStockOrder(工作表1.strID, False, st, strMsg)
Dim rng2 As Range, rng3 As Range
Set rng2 = [a1048576].End(xlUp).Offset(1, 0)
rng2 = strMsg
Set rng3 = 工作表3.[a1048576].End(xlUp).Offset(1, 0)
rng3 = strMsg
rng2.Offset(0, 5).Resize(1, 5).FormulaArray = "=" & rng3.Offset(0, 6).Resize(1, 5).Address(external:=True)
Call 工作表3.RedoReply
End Sub
Sub real_Order(rngCode As Range)
If Not cbxStopAll.Value Then
If CInt(tbxOrderLimit.Text) > 0 Then
'送單，限制減一
tbxOrderLimit.Text = CInt(tbxOrderLimit.Text) - 1
Dim st As STOCKORDER
Dim intBS As Integer, intFlag As Integer
If rngCode.Offset(0, 2) = "B" Then
intBS = 0
intFlag = 0
ElseIf rngCode.Offset(0, 2) = "S" Then
intBS = 1
intFlag = 3
End If
st = stock_order(rngCode.Value, rngCode.Offset(0, 3), intBS, intFlag, rngCode.Offset(0, 4))
Dim rt As Integer
Dim strMsg As String
rt = skO.SendStockOrder(工作表1.strID, False, st, strMsg)
rngCode.Offset(0, -2) = strMsg
Dim rng3 As Range
Set rng3 = 工作表3.[a1048576].End(xlUp).Offset(1, 0)
rng3.Value = strMsg
rngCode.Offset(0, 3).Resize(1, 5).FormulaArray = "=" & rng3.Offset(0, 6).Resize(1, 5).Address(external:=True)
End If
Call 工作表3.RedoReply
End If
End Sub
'sFlag; //0:現股 1:融資 2:融券 3:無券
Private Function stock_order(strCode As String, strPrice As String, sbuysell As Integer, sflag As Integer, intQty As Integer) As SKCOMLib.STOCKORDER
Dim st As SKCOMLib.STOCKORDER
st.bstrFullAccount = [xfd1]
st.bstrPrice = strPrice
st.bstrStockNo = strCode
st.nQty = intQty
st.nSpecialTradeType = IIf(strPrice = "0", 1, 2)
st.nTradeType = 0
st.sbuysell = sbuysell
st.sflag = sflag
st.sPeriod = 0
st.sPrime = 0
stock_order = st
End Function
工作表3
Public WithEvents skR As SKCOMLib.SKReplyLib
Dim strData As String
Enum ri
KeyNo '委託序號(成交回報無此欄)
MarketType ' TS:證券 TA:盤後 TL:零股 TF:期貨
'TO:選擇權 OF:海期 OO:海選 OS:複委託
sType ' N:委託 C:取消 U:改量 P:改價 (改價含證券逐筆)
' D:成交 B:改價改量
' S:動態退單
OrderErr ' Y:失敗 T:逾時 N:正常
Broker ' TS,TA,TL: 分公司代號 unit no , TF,TO: IB 代號 broker id
CustNo ' 交易帳號
BuySell
' 證[0] B/S 買/賣，[1,2] 00 現股，01 代資，02 代券，03 融資，04 融券，20 零股，40 拍賣現股
' 證逐筆[0] B/S 買/賣，[1,2] 00 現股，01 代資，02 代券，03 融資，04 融券，20 零股，40 拍賣現股 [3] I/R/F IOC / ROD / FOK [4] 1/2 市價/限價
' 期[0] B/S 買/賣，[1] Y/當沖, N/新倉, O/平倉, 7/代沖銷， [2] I/R/F IOC / ROD / FOK，[3] 1/2/3/4/5 市價/限價/停損/停損限價/收市
' 權[0] B/S 買/賣，[1] N/O 新倉 / 平倉, 7/代沖銷，[2] I/R/F IOC / ROD / FOK，[3]1/2/3/4/5 市價/限價/停損/停損限價/收市
'海期海選[0] B/S 買/賣，[1]1/2/3/4/5 市價/限價/停損/停損限價/收市，[2] Y/N/O 當沖 / 新倉 / 平倉
'複委託[0] B/S 買/賣，[1]1/2/3/4/5 市價/限價/停損/停損限價/收市
ExchangeID ' 交易所
ComId ' 商品代碼
StrikePrice ' 履約價 七位整數
OrderNo ' 委託書號
Price ' 價格, 已經處理的價格
' 其餘為根據 Type 種類不同，「委託」為委託價；「成交」為成交價;
' 「改價」為修改後價格;「動態退單」為交易所提供之退單基準價
Numerator ' 海外期貨回報用，分子
Denominator ' 海外期貨回報用，分母
Price1 '海外期貨回報用，觸發價格
'國內期選成交時，第一隻腳成交價
Numerator1 '海外期貨回報用，觸發價格分子
Denominator1 ' 海外期貨回報用，觸發價格分母
Price2 '國內期選成交時，第二隻腳成交價
Numerator2 '
Denominator2 '
Qty ' TS OS股數/ TF TO OF OO口數
' 根據 Type 種類，「委託」為委託量，「成交」為成交量，「改量」為減量數，「刪單」為原委託剩量
BeforeQty ' 參考欄位，異動變更前量，刪單為空值
AfterQty ' 參考欄位，異動變更後量，刪單為空值
Date ' 交易日期
tTime ' 交易時間(含冒號EX: 01:02:03)
OkSeq ' 成交序號
SubID ' 子帳帳號
SaleNo ' 營業員編號
Agent ' 委託介面
TradeDate '委託日期(僅提供海外委託，國內尚未提供)
MsgNo '回報流水號
PreOrder ' A:盤中單 B:預約單(僅國內期、選委託)
ComId1 '第一隻腳商品代碼
YearMonth1 '第一隻腳商品結算年月
StrikePrice1 ' 第一隻腳商品履約價
ComId2 '第二隻腳商品代碼
YearMonth2 '第二隻腳商品結算年月
StrikePrice2 ' 第二隻腳商品履約價
ExecutionNo '成交序號
PriceSymbol '下單期標
Reserved '盤別'A：T盤 B：T+1盤 (僅國內期、選委託)
OrderEffective '有效委託日
CallPut '選擇權類型C：Call P：Put
OrderSeq '交易所單號(依海外交易所實際提供為主)
End Enum
Private Sub skR_OnComplete(ByVal bstrUserID As String)
Call 工作表1.addText("complete")
End Sub
Private Sub skR_OnNewData(ByVal bstrUserID As String, ByVal bstrData As String)
If Application.Ready Then
Dim strI() As String
strI = Split(bstrData, ",")
'只收本帳號的回報
If strI(ri.Broker) & strI(ri.CustNo) = 工作表2.[xfd1] Then
'正常才繼續
If strI(ri.OrderErr) = "N" Then
If WorksheetFunction.CountIf(Range([a2], [a1048576].End(xlUp)), strI(ri.KeyNo)) = 0 Then
Call NewRow(strI)
Else
Call AlterRow(strI)
End If
Else
Call 工作表1.addText("Error: " & strI(ri.ComId))
End If
End If
Else
strData = bstrData & "\" & strData
End If
End Sub
'重讀報價
Sub RedoReply()
Dim strI() As String
strI = Split(strData, "\")
For Each stra In strI
If Len(CStr(stra)) > 10 Then
Call skR_OnNewData("", stra)
End If
Next
strData = ""
End Sub
'新增回報
Private Sub NewRow(strI)
With [a1048576].End(xlUp).Offset(1, 0)
.Value = strI(ri.KeyNo)
.Offset(0, 1) = strI(ri.OrderNo)
.Offset(0, 2) = strI(ri.ComId)
.Offset(0, 3) = Code2Name(strI(ri.ComId))
.Offset(0, 4) = Mid(strI(ri.BuySell), 1, 1)
.Offset(0, 11) = CDate(strI(ri.tTime))
Select Case strI(ri.sType)
Case "N"
.Offset(0, 5) = CDate(strI(ri.tTime))
.Offset(0, 6) = CSng(strI(ri.Price))
.Offset(0, 7) = CInt(strI(ri.Qty)) / 1000
Case "C", "U"
.Offset(0, 8) = CInt(strI(ri.Qty)) / 1000
Case "D"
Dim intV As Integer
intV = .Offset(0, 9) + CInt(strI(ri.Qty)) / 1000
.Offset(0, 10) = (.Offset(0, 10) * .Offset(0, 9) + CInt(strI(ri.Qty)) / 1000 * CSng(strI(ri.Price))) / intV
.Offset(0, 9) = intV
Case "P"
.Offset(0, 6) = CSng(strI(ri.Price))
Case Else
工作表1.tbxR.Text = 工作表1.tbxR.Text & vbCrLf & "異常回報：" & strI(ri.sType)
End Select
End With
End Sub
'修改回報
Private Sub AlterRow(strI)
With [a1].Offset(WorksheetFunction.Match(strI(ri.KeyNo), Range([a2], [a1048576].End(xlUp)), 0), 0)
.Offset(0, 11) = CDate(strI(ri.tTime))
Select Case strI(ri.sType)
Case "N"
.Offset(0, 1) = strI(ri.OrderNo)
.Offset(0, 2) = strI(ri.ComId)
.Offset(0, 3) = Code2Name(strI(ri.ComId))
.Offset(0, 4) = Mid(strI(ri.BuySell), 1, 1)
.Offset(0, 5) = CDate(strI(ri.tTime))
.Offset(0, 6) = CSng(strI(ri.Price))
.Offset(0, 7) = CInt(strI(ri.Qty)) / 1000
Case "C", "U"
.Offset(0, 8) = CInt(strI(ri.Qty)) / 1000
Case "D"
Dim intV As Integer
intV = .Offset(0, 9) + CInt(strI(ri.Qty)) / 1000
.Offset(0, 10) = (.Offset(0, 10) * .Offset(0, 9) + CInt(strI(ri.Qty)) / 1000 * CSng(strI(ri.Price))) / intV
.Offset(0, 9) = intV
Case "P"
.Offset(0, 6) = CSng(strI(ri.Price))
Case Else
工作表1.tbxR.Text = 工作表1.tbxR.Text & vbCrLf & "異常回報：" & strI(ri.sType)
End Select
End With
End Sub
'傳回股名
Private Function Code2Name(strCode) As String
Dim strName As String
Dim rngCode As Range
Set rngCode = ThisWorkbook.Names("報價").RefersToRange.Offset(0, -1).Resize(, 1)
If WorksheetFunction.CountIf(rngCode, strCode) > 0 Then
strName = 工作表1.[b1].Offset(WorksheetFunction.Match(strCode, rngCode, 0), 0)
Else
strName = "Unknown"
End If
Code2Name = strName
End Function
Private Sub skR_OnReplyMessage(ByVal bstrUserID As String, ByVal bstrMessage As String, sConfirmCode As Integer)
sConfirmCode = True
'MsgBox (bstrMessage)
End Sub
Sub connect_reply()
If [a1048576].End(xlUp).Row > 1 Then
Range([a2], [a1048576].End(xlUp)).EntireRow.ClearContents
End If
Call skR.SKReplyLib_ConnectByID(工作表1.strID)
End Sub
UserForm1
Private Sub btnCancel_Click() Call Unload(Me) End Sub Private Sub btnOK_Click() 工作表1.strID = tbxID.Text 工作表1.strPW = tbxPW.Text Call Unload(Me) End Sub