excel 从OPC服务器读取数据，老是报下表越界，请各位看看错在哪里啊？调试时黄标指向红色字体那一行
Option ExplicitOption Base 1
Dim WithEvents MyOPCServer As OpcServer
Dim WithEvents MyOPCGroup As OPCGroup
Dim MyOPCGroupColl As OPCGroups
Dim MyOPCItemColl As OPCItems
Dim MyOPCItems As OPCItems
Dim MyOPCItem As OPCItem
Dim plcVal() As Variant
Dim ClientHandles(100) As Long
Dim ServerHandles() As Long
Dim Values(100) As Variant
Dim Errors() As Long
Dim ItemIDs(100) As String
Dim GroupName As String
Dim NodeName As String
Dim ServerName As String
'---------------------------------------------------------------------
' Sub StartClient()
' Purpose: Connect to OPC_server, create group and add item
'---------------------------------------------------------------------
Sub StartClient()
On Error GoTo ErrorHandler
'----------- We freely can choose a ClientHandle and GroupName
ClientHandles(1) = 1
ClientHandles(2) = 2
ClientHandles(3) = 3
GroupName = "MyGroup"
'----------- Get the ItemID from cell "A1"
NodeName = Range("A1").Value
ServerName = "OPCServer.WinCC" 'Range("B1").Value
ItemIDs(1) = Range("A3").Value
ItemIDs(2) = Range("A4").Value
ItemIDs(3) = Range("A5").Value
'增加tag2
'----------- Get an instance of the OPC server
Set MyOPCServer = New OpcServer
MyOPCServer.Connect ServerName, NodeName
Set MyOPCGroupColl = MyOPCServer.OPCGroups
'----------- Set the default active state for adding groups
MyOPCGroupColl.DefaultGroupIsActive = True
'----------- Add our group to the Collection
Set MyOPCGroup = MyOPCGroupColl.Add(GroupName)
Set MyOPCItemColl = MyOPCGroup.OPCItems
'----------- Add one item, ServerHandles are returned
MyOPCItemColl.AddItems 2, ItemIDs, ClientHandles, ServerHandles, Errors
'----------- A group that is subscribed receives asynchronous notifications
MyOPCGroup.IsSubscribed = True
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical, "ERROR"
Err.Clear
End Sub
'---------------------------------------------------------------------
' Sub StopClient()
' Purpose: Release the objects and disconnect from the server
'---------------------------------------------------------------------
Sub StopClient()
'----------- Release the Group and Server objects
On Error Resume Next
MyOPCGroupColl.RemoveAll
'----------- Disconnect from the server and clean up
MyOPCServer.Disconnect
Set MyOPCItemColl = Nothing
Set MyOPCGroup = Nothing
Set MyOPCGroupColl = Nothing
Set MyOPCServer = Nothing
End Sub
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButton2_Click()
End Sub
'---------------------------------------------------------------------
' Sub MyOPCGroup_DataChange()
' Purpose: This event is fired when a value, quality or timestamp in our Group has changed
'---------------------------------------------------------------------
'----------- If OPC-DA Automation 2.1 is installed, use:
Private Sub MyOPCGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
'----------- Set the spreadsheet cell values to the values read
If NumItems = 1 Then
Select Case ClientHandles(1)
Case 1
Range("B3").Value = CStr(ItemValues(1))
Range("C3").Value = Hex(Qualities(1))
Range("D3").Value = CStr(TimeStamps(1))
Case 2
Range("B4").Value = CStr(ItemValues(1))
Range("C4").Value = Hex(Qualities(1))
Range("D4").Value = CStr(TimeStamps(1))
Case 3
Range("B5").Value = CStr(ItemValues(1))
Range("C5").Value = Hex(Qualities(1))
Range("D5").Value = CStr(TimeStamps(1))
Case Else
End Select
Else
Range("B3").Value = CStr(ItemValues(1))
Range("C3").Value = Hex(Qualities(1))
Range("D3").Value = CStr(TimeStamps(1))
Range("B4").Value = CStr(ItemValues(2))
Range("C4").Value = Hex(Qualities(2))
Range("D4").Value = CStr(TimeStamps(2))
Range("B5").Value = CStr(ItemValues(3))
Range("C5").Value = Hex(Qualities(3))
Range("D5").Value = CStr(TimeStamps(3))
End If
End Sub
Private Sub MyOPCServer_ServerShutDown(ByVal Reason As String)
End Sub
Private Sub StartOPC_Click()
StartClient
End Sub
Private Sub StopOPC_Click()
StopClient
End Sub
'---------------------------------------------------------------------
' Sub worksheet_change()
' Purpose: This event is fired when our worksheet changes, so we can write a new value
'---------------------------------------------------------------------
Private Sub worksheet_change(ByVal Selection As Range)
'----------- Only if cell "B3" changes, write this value
'If Selection <> Range("B2") Then Exit Sub
'Values(1) = Selection.Cells.Value
'----------- Write the new value in synchronous mode
Values(1) = Range("B3")
Values(2) = Range("B4")
Values(3) = Range("B5")
MyOPCGroup.SyncWrite 2, ServerHandles, Values, Errors
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Values(1) = Target
End Sub
[此贴子已经被作者于2022-7-19 15:22编辑过]
