以文本方式查看主题

-  金字塔客服中心 - 专业程序化交易软件提供商  (http://weistock.com/bbs/index.asp)
--  高级功能研发区  (http://weistock.com/bbs/list.asp?boardid=5)
----  计算股指合约当天收盘前结算价并输出到Excel  (http://weistock.com/bbs/dispbbs.asp?boardid=5&id=25107)

--  作者:xieguihua
--  发布时间:2012/8/30 14:51:42
--  把金字塔画线的定位方式 改为

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表格。

 

 

 

小生从此论坛学到不少东西,现将最近做的一个程序上传,里面有不少内容借鉴论坛内前辈高人的知识,如有版权侵犯,还请包涵。同时该程序还不少不足之处,有待改正,望塔友建议之。

 

 


--  作者:guotx2010
--  发布时间:2012/8/30 17:44:22
--  
直接把计算结算价部分的代码写到vba代码内部,不用excel,效果会更好。
--  作者:sun884588
--  发布时间:2012/8/31 4:11:51
--  
学习了,大师有传人了。