工业通讯协议 举例 EXCEL 脚本读取 OPC DA 制作生产数据报表_opc通讯推送excle数据

还是大学时 做的东东 。。。好久远的感觉 excel 读取wincc OPC DA server

废话不多说 上图 上代码

excel 中加入脚本代码

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(2) As Long
 
Dim ServerHandles() As Long
 
Dim Values(2) As Variant
 
Dim Errors() As Long
 
Dim ItemIDs(2) 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
 
  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    '增加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 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))
          
    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")
  MyOPCGroup.SyncWrite 2, ServerHandles, Values, Errors
 
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Values(1) = Target
 
End Sub

这样就可以把OPC DA server 中的数据读取出来 并按照自己格式 制作生产数据报表了

excel 文件 qq：553016857