-- 作者:黑黑若
-- 发布时间:2014/3/6 10:48:35
--
Public MyXL private StockCode(30),StockMarket(30) Sub APPLICATION_VBAStart() Call Application.SetTimer(10, 500) GetExcelFile("D:\\Stock.xlsx") End Sub Sub APPLICATION_Timer(ID) GetStockCode GetNewPrice end sub Sub GetNewPrice() dim i dim j on error resume next i=CDbl(Document.GetPrivateProfileString("Stock","StockCount",1,"D:\\StockCode.INI")) For j=1 to i application.MsgOut "正在导出:" & StockCode(j) & "行情..." Set Report1 = marketdata.GetReportData(StockCode(j),StockMarket(j)) MyXL.Application.activesheet.Range("A" & Cstr(j+1)) = StockCode(j) MyXL.Application.activesheet.Range("B" & Cstr(j+1)) = Report1.NewPrice MyXL.Application.activesheet.Range("C" & Cstr(j+1)) = Report1.LastClose MyXL.Application.activesheet.Range("D" & Cstr(j+1)) = Report1.LastHigh MyXL.Application.activesheet.Range("E" & Cstr(j+1)) = Report1.LastLow MyXL.Application.activesheet.Range("F" & Cstr(j+1)) = Report1.Open MyXL.Application.activesheet.Range("G" & Cstr(j+1)) = Report1.High MyXL.Application.activesheet.Range("H" & Cstr(j+1)) = Report1.Low Next End Sub \'取得要监控的品种代码 Sub GetStockCode() dim i dim j i=CDbl(Document.GetPrivateProfileString("Stock","StockCount",1,"D:\\StockCode.INI")) For j=1 to i StockCode(j)=Document.GetPrivateProfileString("Stock","Code" & Cstr(j),"","D:\\StockCode.INI") \'品种号码 StockMarket(j)=Document.GetPrivateProfileString("Stock","Market" & Cstr(j),"","D:\\StockCode.INI") \'交易所代码 \'application.MsgOut "i:" & i & "," & stockcode(j) & "," & StockMarket(j) Next End Sub \'打开Excel Sub GetExcel() Const ERR_APP_NOTRUNNING = 429 On Error Resume Next Set MyXL = GetObject(, "Excel.Application") If Err = ERR_APP_NOTRUNNING Then Set MyXL = CreateObject("Excel.Application") End If MyXL.Application.Visible = True End Sub \'打开某个excel文件 Sub GetExcelFile(sFileName) \'此过程暂停使用,替代过程为:GetExcel Dim sWinName \'窗口名 Dim iPos \'测试 Microsoft Excel 的副本是否在运行。 On Error Resume Next \'延迟错误捕获。 \'不带第一个参数调用 Getobject 函数将 \'返回对该应用程序的实例的引用。 \'如果该应用程序不在运行,则会产生错误。 Set MyXL = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set MyXL = CreateObject("Excel.Application") End if \'将对象变量设为对要看的文件的引用。 Set MyXL = GetObject(sFileName) iPos = InStrRev(sFileName, "\\", -1, vbTextCompare) sWinName = Mid(sFileName, iPos + 1, Len(sFileName) - iPos - 4) \'设置其 Application 属性,显示 Microsoft Excel。 \'然后使用 MyXL 对象引用的 Windows 集合 \'显示包含该文件的实际窗口。 MyXL.Application.Visible = True MyXL.Application.ScreenUpdating = True MyXL.Parent.Windows(1).Activate MyXl.Application.Sheets(1).Visible=true End Sub \'关闭Excel Sub CloseExcel() On Error Resume Next MyXL.Application.DisplayAlerts = False \'MyXL.Application.Save MyXL.Application.Quit \' Set MyXL = Nothing \'释放对该应用程序 End Sub --------------------------------------------------------------------------
这是全部。请检查,谢谢。如果仍有问题,我拟明日去公司当面咨询。可否私信电话联系。
|