Public MyXL
private StockCode(30),StockMarket(30)

Sub APPLICATION_VBAStart()
 Call Application.SetTimer(10, 500)
 GetExcelFile("D:\Stock.xls")
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 "正在導(dǎo)出:" & StockCode(j) & "行情..."
   Set Report1 = marketdata.GetReportData(StockCode(j),StockMarket(j))
   MyXL.Application.activesheet.Range("C" & Cstr(j+3)) =  StockCode(j)
  MyXL.Application.activesheet.Range("D" & Cstr(j+3)) =  report1.BuyPrice1
  MyXL.Application.activesheet.Range("E" & Cstr(j+3)) =  report1.SellPrice1
 Next  
End Sub

'取得要監(jiān)控的品種代碼
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")  '品種號(hào)碼
  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
'打開某個(gè)excel文件
Sub GetExcelFile(sFileName)
    '此過(guò)程暫停使用,替代過(guò)程為:GetExcel

    Dim sWinName                '窗口名
    Dim iPos
   
    '測(cè)試 Microsoft Excel 的副本是否在運(yùn)行。
    On Error Resume Next    '延遲錯(cuò)誤捕獲。
    '不帶第一個(gè)參數(shù)調(diào)用 Getobject 函數(shù)將
    '返回對(duì)該應(yīng)用程序的實(shí)例的引用。
    '如果該應(yīng)用程序不在運(yùn)行，則會(huì)產(chǎn)生錯(cuò)誤。
    Set MyXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
  Set MyXL = CreateObject("Excel.Application")
 End if

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

'關(guān)閉Excel
Sub CloseExcel()
    On Error Resume Next
    MyXL.Application.DisplayAlerts = False
    'MyXL.Application.Save
    MyXL.Application.Quit
'    Set MyXL = Nothing    '釋放對(duì)該應(yīng)用程序
End Sub

使用說(shuō)明：

   1、新建一個(gè)模塊，將上述代碼復(fù)制到新建的模塊；

   2、在D:\建立一個(gè)Excel文件，命名為Stock.xls

   3、在D:\建立一個(gè)StockCode.ini文件，設(shè)置需要導(dǎo)出的代碼，格式如下：

     [Stock]
     StockCount=5           

     Code1=TWGD
     Market1=XH

     Code2=XHAP
     Market2=XH

     Code3=XHGT
     Market3=XH

     Code4=XHPD
     Market4=XH

     Code5=XHGT
     Market5=XH

     ...

    說(shuō)明：StockCount=5那行指定要導(dǎo)出的期貨品種數(shù)

            下面的Code1是第一個(gè)品種的代碼，Market1是該商品的市場(chǎng)代碼，以下代碼依次按照序號(hào)往下編排。

使用此模塊可以同時(shí)導(dǎo)出15個(gè)左右品種的行情數(shù)據(jù)，每0.5秒導(dǎo)出一次，品種再多的話，可能會(huì)出現(xiàn)延時(shí)現(xiàn)象，我試過(guò)使用多個(gè)計(jì)時(shí)器同時(shí)導(dǎo)出，每一個(gè)計(jì)時(shí)器導(dǎo)出10個(gè)品種，可以減小延時(shí)現(xiàn)象，但是會(huì)出現(xiàn)運(yùn)行不穩(wěn)定，運(yùn)行10幾分鐘就自動(dòng)停止，如果金字塔的VBA后臺(tái)能支持多線程，可能就可以很好的解決這個(gè)問(wèn)題。

先打開Excel文件，再啟動(dòng)金字塔就行了。