計算股指合約當天收盤前結算價并輸出到Excel　[金字塔]

Public MyXLL
private StockCod(14),StockMarke(30)

Sub APPLICATION_VBAStart()
 Call Application.SetTimer(10, 500)
 GetExcelFile("F:\test_jzt\Stock_index_fut.xlsx")
End Sub

Sub APPLICATION_Timer(ID)
if cdate(time)>="10:52:00" then
GetStockCode
GetNewPrice
end if
end sub

'取得要監控的品種代碼
Sub GetStockCode()
 dim i
 dim j
 i=CDbl(Document.GetPrivateProfileString("Stock","StockCount",1,"F:\test_jzt\Stock_index_fut.INI")) '品種數量
 For j=0 to i
  StockCod(j)=Document.GetPrivateProfileString("Stock","Cod" & Cstr(j),"","F:\test_jzt\Stock_index_fut.INI")  '品種號碼
 Next
End Sub

'取得對應品種的最新價格
Sub GetNewPrice()
 dim j
 dim i
 on error resume next
 i=CDbl(Document.GetPrivateProfileString("Stock","StockCount",1,"F:\test_jzt\Stock_index_fut.INI")) '取得合約數量
 For j=0 to i
   Set Report1 = marketdata.GetReportData(StockCod(j),"ZJ") '
   if cdate(time)<="14:15:01" then  '取得到兩點十五分的數據
     if Report1.volume>0 then
        MyXLL.Application.activesheet.Range("B" & Cstr(j+2)) =  StockCod(j)
        MyXLL.Application.activesheet.Range("C" & Cstr(j+2)) = report1.newprice
        MyXLL.Application.activesheet.Range("D" & Cstr(j+2)) =  report1.volume
        MyXLL.Application.activesheet.Range("E" & Cstr(j+2)) =  report1.SellAmount
        MyXLL.Application.activesheet.Range("F" & Cstr(j+2)) =  report1.BuyAmount
     end if  
   else
     if Report1.volume>0 then '取得最新數據
        MyXLL.Application.activesheet.Range("G" & Cstr(j+2)) = report1.newprice
        MyXLL.Application.activesheet.Range("H" & Cstr(j+2)) =  report1.volume
        MyXLL.Application.activesheet.Range("I" & Cstr(j+2)) =  report1.SellAmount
        MyXLL.Application.activesheet.Range("J" & Cstr(j+2)) =  report1.BuyAmount
     end if
  end if
 Next 
End Sub

'打開Excel
Sub GetExcel()
    Const ERR_APP_NOTRUNNING = 429
 
    On Error Resume Next
    Set MyXLL = GetObject(, "Excel.Application")
    If Err = ERR_APP_NOTRUNNING Then
        Set MyXLL = CreateObject("Excel.Application")
    End If
   
    MyXLL.Application.Visible = True
End Sub
'打開某個excel文件
Sub GetExcelFile(sFileName)
    '此過程暫停使用,替代過程為:GetExcel

    Dim sWinName                '窗口名
    Dim iPos
   
    '測試 Microsoft Excel 的副本是否在運行。
    On Error Resume Next    '延遲錯誤捕獲。
    '不帶第一個參數調用 Getobject 函數將
    '返回對該應用程序的實例的引用。
    '如果該應用程序不在運行，則會產生錯誤。
    Set MyXLL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
  Set MyXLL = CreateObject("Excel.Application")
 End if

    '將對象變量設為對要看的文件的引用。
    Set MyXLL = GetObject(sFileName)
   
    iPos = InStrRev(sFileName, "\", -1, vbTextCompare)
    sWinName = Mid(sFileName, iPos + 1, Len(sFileName) - iPos - 4)
   
    '設置其 Application 屬性，顯示 Microsoft Excel。
    '然后使用 MyXL 對象引用的 Windows 集合
    '顯示包含該文件的實際窗口。
    MyXLL.Application.Visible = True
    MyXLL.Application.ScreenUpdating = True
    MyXLL.Parent.Windows(1).Activate
    MyXLL.Application.Sheets(1).Visible=true
End Sub

'關閉Excel
Sub CloseExcel()
    On Error Resume Next
    MyXLL.Application.DisplayAlerts = False
    'MyXL.Application.Save
    MyXLL.Application.Quit
'    Set MyXL = Nothing    '釋放對該應用程序
End Sub

建立一個名為F:\test_jzt\Stock_index_fut.ini格式文件，內容為：

 [Stock]
     StockCount=13        
     Cod0=IF00
     Cod1=IF01
     Cod2=IF02
     Cod3=IF03
     Cod4=IF04
     Cod5=IF05
     Cod6=IF06
     Cod7=IF07
     Cod8=IF08
     Cod9=IF09
     Cod10=IF10
     Cod11=IF11
     Cod12=IF12
     Cod13=IF13

建立一個F:\test_jzt\Stock_index_fut.xls表格。

小生從此論壇學到不少東西，現將最近做的一個程序上傳，里面有不少內容借鑒論壇內前輩高人的知識，如有版權侵犯，還請包涵。同時該程序還不少不足之處，有待改正，望塔友建議之。