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