如何为 Excel 创建 RealTimeData 服务器

项目
06/20/2023
适用于:

Microsoft Excel

摘要

Microsoft Excel 提供了一个新的工作表函数 RTD，可用于调用组件对象模型 (COM) 自动化服务器，以便实时检索数据。本文介绍如何使用 Visual Basic 创建用于 Excel RTD 函数的 RealTimeData 服务器。

更多信息

RTD 工作表函数具有以下语法：

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

第一个参数 ProgID 表示 RealTimeData 服务器的 Programmatic 标识符 (ProgID) 。服务器参数指示运行 RealTimeData 服务器的计算机的名称;如果 RealTimeData 服务器要在本地运行，则此参数可以是 null 字符串或省略。其余参数只是表示要发送到 RealTimeData 服务器的参数;这些参数的每个唯一组合表示一个“主题”，其中包含关联的“主题 ID”。参数区分大小写。例如，以下说明对 RTD 服务器的调用将导致三个单独的主题 ID：

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

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

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

为了使 COM 自动化服务器成为用于 Excel RTD 函数的 RealTimeData 服务器，它必须实现 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，并返回要更新的主题计数以及每个主题的主题 ID 和值。

创建示例 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。将以下代码添加到 Topic 类模块：

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 Server

在 Microsoft Excel 中启动新工作簿。
在单元格 A1 中，输入以下公式，然后按 ENTER 键：

=RTD (“ExcelRTD.RTDFunctions”，“AAA”，5)

初始返回值为“AAA：0”。 5 秒后，值将更新为“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”。每隔 5 秒，单元格值就会像其他单元格一样递增。请注意，返回值与单元格 A1 或 A3 的内容不匹配，因为传递给服务器的参数组合不同。

对于此图，已编译 RTD 服务器，Excel 使用组件的运行时版本。出于调试目的，可从 Visual Basic IDE 运行 RTD 服务器。

若要在调试模式下运行：

退出 Microsoft Excel，在 Visual Basic 中切换到项目。
按 F5 启动组件。如果出现“项目属性”对话框，请单击“确定”，选择“等待创建组件”的默认选项。
确保显示 Visual Basic 中的“即时”窗口。在单元格中输入公式并更新单元格时，请检查 Visual Basic 中“即时”窗口的内容，查看触发不同事件的操作。

注意

关于 DisconnectData 事件

虽然 Excel 是 RTD 服务器的订阅者，但在不再需要主题 (（例如，在单元格) 中删除或清除 RTD 公式时）会触发 DisconnectData 事件。但是，当工作簿关闭或 Excel 退出时，Excel 不会对 RTD 服务器的每个主题调用 DisconnectData;相反，Excel 仅调用 ServerTerminate。创建 RTD 服务器时，应在服务器Terminate 事件触发时对主题或其他对象进行任何必要的清理。

通过

如何为 Excel 创建 RealTimeData 服务器

摘要

更多信息

创建示例 RealTimeData 服务器

在 Excel 中使用 RTD Server

其他资源