如何建立適用于 Excel 的 RealTimeData 伺服器

發行項
06/20/2023
適用於:

Microsoft Excel

摘要

Microsoft Excel 提供新的工作表函式 RTD，可讓您呼叫元件物件模型 (COM) 自動化伺服器，以即時擷取資料。本文說明如何使用 Visual Basic 來建立 RealTimeData Server，以搭配 Excel 的 RTD 函式使用。

其他相關資訊

RTD 工作表函式具有下列語法：

=RTD(ProgID,Server,String1,[String2],...)

第一個引數 ProgID 代表 RealTimeData 伺服器的程式設計識別碼 (ProgID) 。 Server 引數會指出執行 RealTimeData 伺服器的電腦名稱稱;如果 RealTimeData 伺服器要在本機執行，則這個引數可以是 Null 字串或省略。其餘的引數只是代表要傳送至 RealTimeData 伺服器的參數;這些參數的每個唯一組合都代表一個「主題」，其中具有相關聯的「主題識別碼」。參數會區分大小寫。例如，下列說明對 RTD 伺服器的呼叫，這會導致三個不同的主題識別碼：

=RTD("ExcelRTD.RTDFunctions",,"AAA", "10")

=RTD("ExcelRTD.RTDFunctions",,"AAA", "5")

=RTD("ExcelRTD.RTDFunctions",,"aaa", "5")

為了讓 COM 自動化伺服器成為 RealTimeData Server 以搭配 Excel 的 RTD 函式使用，它必須實作 IRTDServer 介面。伺服器必須實作 IRTDServer 的所有方法：

ServerStart：當 Excel 要求伺服器的第一個 RTD 主題時呼叫。 ServerStart 應該會在成功時傳回 1，失敗時則傳回負值或 0。 ServerStart 方法的第一個參數是 RealTimeData 伺服器用來在應該從 RealTimeData 伺服器收集更新時通知 Excel 的回呼物件。
ServerTerminate：當 Excel 不再需要 RealTimeData 伺服器的 RTD 主題時呼叫。
ConnectData：每當 Excel 向 RealTimeData 伺服器要求新的 RTD 主題時呼叫。
DisconnectData：每當 Excel 不再需要特定主題時呼叫。
HeartBeat：如果在上次收到來自 RealTimeData 伺服器的更新通知 Excel 之後經過指定的間隔，由 Excel 呼叫。
RefreshData：當 Excel 要求重新整理主題時呼叫。在伺服器通知 Excel 有更新存在之後，就會呼叫 RefreshData，並傳回要更新的主題計數，以及每個主題的主題識別碼和值。

建立範例 RealTimeData 伺服器

下列範例示範如何使用 Microsoft Excel 2002 建立和使用 RealTimeData 伺服器。此伺服器只會提供在工作表上每隔 10 秒更新一次的計數器。伺服器最多可接受兩個主題字串。第一個主題字串可以是 AAA、BBB 和 CCC;任何其他主題字串都被視為無效，而且伺服器會傳回#VALUE！至 RTD 函式。第二個字串是數值，表示應如何遞增傳回值。如果省略第二個字串，則遞增值預設為 1。如果第二個字串不是數值，伺服器會傳回#NUM！至 RTD 函式。

在 Visual Basic 中啟動新的 ActiveX DLL 專案。
在 [ 專案] 功能表上，按一下 [ 參考]，選取您 Excel 版本的 [物件程式庫]，然後按一下 [ 確定]。例如，選取下列其中一項：
- 針對 Microsoft Office Excel 2007，選取 [Microsoft Excel 12.0 物件程式庫]。
- 針對 Microsoft Office Excel 2003，選取 [Microsoft Excel 11.0 物件程式庫]。
- 針對 Microsoft Excel 2002，選取 [Microsoft Excel 10.0 物件程式庫]。
在 [專案] 功能表上，按一下 [Project1 屬性]。將 [專案名稱] 變更為 ExcelRTD，然後按一下 [確定]。

將類別模組 Class1 的 Name 屬性變更為 RTDFunctions。將下列程式碼新增至 RTDFunctions：

Option Explicit

Implements IRtdServer  'Interface allows Excel to contact this RealTimeData server

Private m_colTopics As Collection

Private Function IRtdServer_ConnectData(ByVal TopicID As Long, Strings() As Variant, GetNewValues As Boolean) As Variant
    '** ConnectData is called whenever a new RTD topic is requested

'Create a new topic class with the given TopicId and string and add it to the
    'm_colTopics collection
    Dim oTopic As New Topic
    m_colTopics.Add oTopic, CStr(TopicID)
    oTopic.TopicID = TopicID
    oTopic.TopicString = Strings(0)
    If UBound(Strings) >= 1 Then oTopic.SetIncrement Strings(1)

'For this example, the initial value for a new topic is always 0
    IRtdServer_ConnectData = oTopic.TopicValue

Debug.Print "ConnectData", TopicID
End Function

Private Sub IRtdServer_DisconnectData(ByVal TopicID As Long)
   '** DisconnectData is called whenever a specific topic is not longer needed

'Remove the topic from the collection
   m_colTopics.Remove CStr(TopicID)

Debug.Print "DisconnectData", TopicID
End Sub

Private Function IRtdServer_Heartbeat() As Long
    '** Called by Excel if the heartbeat interval has elapsed since the last time
    '   Excel was called with UpdateNotify.
    Debug.Print "HeartBeat"
End Function

Private Function IRtdServer_RefreshData(TopicCount As Long) As Variant()
    '** Called when Excel is requesting a refresh on topics. RefreshData will be called
    '   after an UpdateNotify has been issued by the server. This event should:
    '   - supply a value for TopicCount (number of topics to update)
    '   - return a two dimensional variant array containing the topic ids and the
    '     new values of each.

Dim oTopic As Topic, n As Integer
    ReDim aUpdates(0 To 1, 0 To m_colTopics.Count - 1) As Variant
    For Each oTopic In m_colTopics
        oTopic.Update
        aUpdates(0, n) = oTopic.TopicID
        aUpdates(1, n) = oTopic.TopicValue
        n = n + 1
    Next
    TopicCount = m_colTopics.Count
    IRtdServer_RefreshData = aUpdates

Debug.Print "RefreshData", TopicCount & " topics updated"
End Function

Private Function IRtdServer_ServerStart(ByVal CallbackObject As Excel.IRTDUpdateEvent) As Long
    '** ServerStart is called when the first RTD topic is requested

Set oCallBack = CallbackObject
    Set m_colTopics = New Collection
    g_TimerID = SetTimer(0, 0, TIMER_INTERVAL, AddressOf TimerCallback)
    If g_TimerID > 0 Then IRtdServer_ServerStart = 1       'Any value <1 indicates failure.

Debug.Print "ServerStart"
End Function

Private Sub IRtdServer_ServerTerminate()
    '** ServerTerminate is called when no more topics are needed by Excel.

KillTimer 0, g_TimerID

'** Cleanup any remaining topics. This is done here since 
    '   IRtdServer_DisconnectData is only called if a topic is disconnected 
    '   while the book is open. Items left in the collection when we terminate
    '   are those topics left running when the workbook was closed.

Dim oTopic As Topic
    For Each oTopic In m_colTopics
        m_colTopics.Remove CStr(oTopic.TopicID)
        Set oTopic = Nothing
    Next

Debug.Print "ServerTerminate"

End Sub

在 [專案] 功能表上，按一下 [新增類別模組]。將類別模組 Name 屬性變更為 Topic，並將 Instancing 屬性變更為 Private。將下列程式碼新增至主題類別模組：

Option Explicit

Private m_TopicID As Long
Private m_TopicString As String
Private m_Value As Variant
Private m_IncrementVal As Long

Private Sub Class_Initialize()
    m_Value = 0
    m_IncrementVal = 1
End Sub

Friend Property Let TopicID(ID As Long)
    m_TopicID = ID
End Property

Friend Property Get TopicID() As Long
    TopicID = m_TopicID
End Property

Friend Property Let TopicString(s As String)
    s = UCase(s)
    If s = "AAA" Or s = "BBB" Or s = "CCC" Then
        m_TopicString = s
    Else
        m_Value = CVErr(xlErrValue) 'Return #VALUE if not one of the listed topics
    End If
End Property

Friend Sub Update()
    On Error Resume Next 'the next operation will fail if m_Value is an error (like #NUM or #VALUE)
    m_Value = m_Value + m_IncrementVal
End Sub

Friend Sub SetIncrement(v As Variant)
    On Error Resume Next
    m_IncrementVal = CLng(v)
    If Err <> 0 Then
        m_Value = CVErr(xlErrNum) 'Return #NUM if Increment value is not numeric
    End If
End Sub

Friend Property Get TopicValue() As Variant
    If Not (IsError(m_Value)) Then
        TopicValue = m_TopicString & ": " & m_Value
    Else
        TopicValue = m_Value
    End If
End Property

在 [專案] 功能表上，選取 [新增模組]。將下列程式碼新增至新的模組：

Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public Const TIMER_INTERVAL = 5000
Public oCallBack As Excel.IRTDUpdateEvent
Public g_TimerID As Long

Public Sub TimerCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    oCallBack.UpdateNotify
End Sub

在 [檔案] 功能表上，按一下 [建立ExcelRTD.dll] 以建置元件。

在 Excel 中使用 RTD 伺服器

在 Microsoft Excel 中啟動新的活頁簿。
在儲存格 A1 中，輸入下列公式，然後按 ENTER 鍵：

=RTD (「ExcelRTD.RTDFunctions」，，「AAA」， 5)

初始傳回值為「AAA： 0」。五秒之後，值會更新為「AAA： 10」，並在 10 秒之後，值會更新為「AAA：15」，依此類推。
在儲存格 A2 中，輸入下列公式，然後按 ENTER：

=RTD (「ExcelRTD.RTDFunctions」，，「BBB」， 3)

初始傳回值為「BBB： 0」。儲存格值每隔五秒就會遞增 3。
在儲存格 A3 中，輸入下列公式，然後按 ENTER：

=RTD (「ExcelRTD.RTDFunctions」，，「AAA」， 5)

初始傳回值符合儲存格 A1 的內容，因為這是 A1 中使用的相同「主題」。
在儲存格 A4 中，輸入下列公式，然後按 Enter： =RTD (「ExcelRTD.RTDFunctions」，，「AAA」， 10)

初始傳回值為「AAA： 0」。儲存格值每隔五秒就會遞增一次，就像其他儲存格一樣。請注意，傳回值不符合儲存格 A1 或 A3 的內容，因為傳遞至伺服器的參數組合不同。

在此圖中，RTD 伺服器已編譯，而 Excel 使用元件的執行階段版本。基於偵錯目的，您可以從 Visual Basic IDE 執行 RTD 伺服器。

若要在偵錯模式中執行：

結束 Microsoft Excel 並切換至 Visual Basic 中的專案。
按 F5 啟動元件。如果 [專案屬性] 對話方塊出現，請按一下 [確定] 選取 [等候元件建立] 的預設選項。
請確定 Visual Basic 中的 [即時運算] 視窗已顯示。當您在儲存格中輸入公式並更新儲存格時，請檢查 Visual Basic 中 [即時運算] 視窗的內容，以查看哪些動作會觸發不同的事件。

注意事項

關於 DisconnectData 事件

雖然 Excel 是 RTD 伺服器的訂閱者，但它會在不再需要主題時觸發 DisconnectData 事件 (例如，當您刪除或清除儲存格) 中的 RTD 公式時。不過，當活頁簿關閉或 Excel 結束時，Excel 不會在 RTD 伺服器的每個主題上呼叫 DisconnectData;相反地，Excel 只會呼叫 ServerTerminate。當您建立 RTD 伺服器時，您應該在 ServerTerminate 事件引發時撰寫任何必要的主題或其他物件清除程式碼。

如何建立適用于 Excel 的 RealTimeData 伺服器

摘要

其他相關資訊

建立範例 RealTimeData 伺服器

在 Excel 中使用 RTD 伺服器

其他資源