导出到excel时发生的故障 - 高级功能研发区 - 金字塔客服中心 - 专业程序化交易软件提供商

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
--------------------------------------------------------------------------

这是全部。请检查，谢谢。如果仍有问题，我拟明日去公司当面咨询。可否私信电话联系。

主题：导出到excel时发生的故障