| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 289 人关注过本帖
标题:excel 从OPC服务器读取数据,老是报下表越界,请各位看看错在哪里啊?调试时 ...
只看楼主 加入收藏
sbbzb
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2022-7-19
收藏
 问题点数:0 回复次数:3 
excel 从OPC服务器读取数据,老是报下表越界,请各位看看错在哪里啊?调试时黄标指向红色字体那一行
Option Explicit

Option 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编辑过]

搜索更多相关主题的帖子: Value the Dim Sub End 
2022-07-19 15:19
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:29
帖 子:1519
专家分:2337
注 册:2009-12-22
收藏
得分:0 
注释掉红色那一行正调试,看会不会还报错?

心生万象,万象皆程序!
2022-07-20 10:05
sbbzb
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2022-7-19
收藏
得分:0 
回复 二楼的大侠
注释掉该条语句  也不行

[此贴子已经被作者于2022-7-27 08:24编辑过]

2022-07-27 08:22
cwa9958
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:49
帖 子:204
专家分:1121
注 册:2006-6-25
收藏
得分:0 
注释掉的提示还是一样?
确定ItemValues(3)的这个元素,到底有没有,提示了,应该没有这个元素了,但是代码里怎么会有这个元素呢?找下原因。
2022-07-27 08:49
快速回复:excel 从OPC服务器读取数据,老是报下表越界,请各位看看错在哪里啊? ...
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.673210 second(s), 8 queries.
Copyright©2004-2022, BCCN.NET, All Rights Reserved