在Excel中构建OPC客户端

Question

我非常深入地用VBA在Excel中构建了一个非常多方面的小应用程序。它完成了许多任务，主要是使用OPC从几个PLC中获取标记值，并对信息进行各种处理，比如发布一个网页(使用我找到的一个模块，而不是我的)，创建日志文件和表，以及为办公室发出一些可听到的警报。

现在我要做的是，按下按钮，连接到服务器(RSLinx)，然后进入一个循环，首先读取标记值，然后在选中关联复选框时执行上述任务。这将无限期地运行良好，只要用户不使用它或Linx，或者让计算机锁定。

我是一个初学者，所以，请给我一些关于代码本身的反馈，但我真正想做的是使这个防弹，这样它就不会失败。我已经添加了一些东西，比如在选择更改事件上，如果您已经连接了，给出一个消息框，上面写着在运行时不进行更改。但是，我知道这样会好得多。

此外，我已经知道这可能会在其他方面做得更好，但这是一个小初学者的宠物项目，我将看到它之前，我继续前进。欢迎所有的批评。

Option Explicit  ' variables must be declared
Option Base 1    ' array starts at index 1

'Dim OPCServer1 As OPCServer
Dim WithEvents OPCGroup1 As OPCGroup
Dim MyOPCItems() As OPCItem
Dim NumberOfTags As Integer
Dim ReadInterval As Double



Sub OPC_Connect()
    debugEvent "OPC - OPC_Connect()"
    status_update ("Connecting...")
    On Error GoTo Error_OpcConnectionFailure
    Dim GrpName As String
    Dim i As Integer
    Dim g As Integer
    Dim h As Integer
    Dim row_tag_name As String

    For h = 1 To 7
        Module1.SavedThisTime(h) = False
    Next h

    ThisWorkbook.connected = True
    GrpName = Cells(5, 2)
    'NumberOfTags = Cells(6, 2)
    NumberOfTags = 0
    status_update ("Adding Tags...")
    For g = 1 To 10000
        If Not IsEmpty(Cells(4 + g, 4).value) Then
            NumberOfTags = NumberOfTags + 1
        End If
    Next g

    If Not ThisWorkbook.OPCServer1 Is Nothing Then       'safety
         Exit Sub

    End If

    Set ThisWorkbook.OPCServer1 = New OPCServer
    Call ThisWorkbook.OPCServer1.Connect(Cells(4, 2))                'connect to the OPC Server
    Set OPCGroup1 = ThisWorkbook.OPCServer1.OPCGroups.Add(GrpName) 'add the group

    'add the 6 items
    ReDim MyOPCItems(NumberOfTags)


    For i = 1 To NumberOfTags
        On Error GoTo Error_TagNotFound
        If Cells(4 + i, 6) = 1 Then
            row_tag_name = Cells(4 + i, 4) & "." & Cells(4 + i, 5) & ",L1,C1"
            Set MyOPCItems(i) = OPCGroup1.OPCItems.AddItem(Cells(4 + i, 4) & "." & Cells(4 + i, 5) & ",L1,C1", i)

        Else
            row_tag_name = Cells(4 + i, 4) & ",L1,C1"
            Set MyOPCItems(i) = OPCGroup1.OPCItems.AddItem(Cells(4 + i, 4) & ",L1,C1", i)
        End If
    Next i
    status_update ("Connected")
    ThisWorkbook.LoggedThisTime = False
    Time_Delay (1)

Exit Sub
    'Debug.Print "OPCServer1 is " & OPCServer1 & " at end of Connect sub"
Error_OpcConnectionFailure:

    OPC_Disconnect
    MsgBox ("Connection Failed:" & vbNewLine & vbNewLine & "Check Your server name and ensure RSLinx is Running.")
    Exit Sub


Error_TagNotFound:

    OPC_Disconnect
    MsgBox ("Connection Failed. Check tag: " & vbNewLine & vbNewLine & row_tag_name)
    Exit Sub

End Sub



Sub OPC_Disconnect()

    ThisWorkbook.connected = False
    debugEvent "OPC - OPC_Disconnect()"
    On Error Resume Next
    If ThisWorkbook.OPCServer1 Is Nothing Then
        Exit Sub
    End If
    Call ThisWorkbook.OPCServer1.OPCGroups.RemoveAll 'free all the items and groups
    Call ThisWorkbook.OPCServer1.Disconnect          'disconnect from the OPC Server
    Set ThisWorkbook.OPCServer1 = Nothing
    ThisWorkbook.OPC_StopReadLoop = True
    status_update ("Not Connected")

End Sub

Sub OPC_RefreshServer()

        debugEvent "OPC - OPC_RefreshServer()"
        OPC_Disconnect
        Time_Delay (1)
        OPC_Connect

End Sub

Sub OPC_Read()

    debugEvent "OPC - OPC_Read()"
    status_update ("Reading Tags...")
    On Error GoTo Error_TagRead
    Dim Temp_Buffer1
    Dim ServerHandles() As Long
    ReDim ServerHandles(NumberOfTags) 'item ID (server side)
    Dim Values() As Variant         'return values
    Dim Errors() As Long

    'these next two are different. They are variant arrays, not arrays of type variant. A variant that is an array of a type.
    Dim Qual As Variant     'not using but must provide for function call
    Dim TimeValue As Variant

    Dim i As Integer

    If ThisWorkbook.OPCServer1 Is Nothing Then 'safety
        If Sheets("Setup").AutoReconnect_ChkBx.value = True Then
            OPC_RefreshServer
        Else
            Exit Sub
        End If
    End If

    If Not (ThisWorkbook.OPCServer1.ServerState = OPCServerState.OPCRunning) Then  'safety
        Exit Sub
    End If

    'set up which items to be read
    For i = 1 To NumberOfTags
        ServerHandles(i) = MyOPCItems(i).ServerHandle
    Next i

    Call OPCGroup1.SyncRead(OPCCache, NumberOfTags, ServerHandles, Values, Errors, Qual, TimeValue)

   'put the value and time stamp in cells

    For i = 1 To NumberOfTags
        Cells(4 + i, 3) = Values(i)
   '    Cells(4 + i, 2) = TimeValue(i)
    Next i
   'free the memory
   Erase Values()
   Erase Errors()

Exit Sub
Error_TagRead:
    OPC_Disconnect
    MsgBox ("Tag Read Error." & vbNewLine & "Please reconnect to server.")
    Exit Sub
End Sub

Sub OPC_Write()

    debugEvent "OPC - OPC_Write()"
    Dim ServerHandles(6) As Long    'item ID (server side)
    Dim Values(6) As Variant        'values
    Dim Errors() As Long
    Dim i As Integer

    If ThisWorkbook.OPCServer1 Is Nothing Then       'safety
     Exit Sub
    End If

    If Not (ThisWorkbook.OPCServer1.ServerState = OPCServerState.OPCRunning) Then  'safety
     Exit Sub
    End If

    'set up which items to be write
    For i = 1 To 6
     ServerHandles(i) = MyOPCItems(i).ServerHandle
    Next i

    'fetch the values from the cells
    For i = 1 To 6
     Values(i) = Cells(8 + i, 3)
     If Values(i) = "" Then
      Values(i) = 0
     End If
    Next i

    Call OPCGroup1.SyncWrite(6, ServerHandles, Values, Errors)

End Sub

Sub ReadBtn_Click()
    debugEvent "OPC - ReadBtn_Click()"
    OPC_Read
End Sub

Sub OPC_LoopRead()

    debugEvent "OPC - OPC_LoopRead()"
    On Error GoTo Error_Reconnect
    ReadInterval = Sheets("Setup").Range("C15")
    ThisWorkbook.enable_audible_alarm = False
    Module1.logged_this_time = False
    Do While ThisWorkbook.OPC_StopReadLoop = False
        Application.Cursor = XlMousePointer.xlDefault
        status_update ("Reading Tags")
        OPC_Read
        status_update ("In Time Delay")
        If Not ThisWorkbook.OPCServer1 Is Nothing Then       'safety

            Time_Delay (ReadInterval)
            If Sheets("Setup").audible_alarms_enable_ChkBx.value = True Then
                status_update ("Sounding Alarms")
                Sheets("Audible Alarms").LoopAudibleAlarms
                status_update ("Done Sounding Alarms")
            End If
            If Sheets("Setup").NewLogRow_ChkBx.value = True Then
                Sheets("Setup").NewLogRow_OnInterval
            End If
            If Sheets("Setup").website_publish_enable_ChkBx.value = True Then
                status_update ("Publishing")
                Publish
                status_update ("Done Publishing")
            End If
            If Sheets("Setup").LogData_ChkBx.value = True Then
                status_update ("Saving Log File")
                LogData
                status_update ("Done Saving Log File")
            End If

        End If
    Loop
    ThisWorkbook.OPC_StopReadLoop = False

Exit Sub
Error_Reconnect:
    If ThisWorkbook.OPCServer1 Is Nothing Then 'safety
        If Sheets("Setup").AutoReconnect_ChkBx.value = True Then
            OPC_RefreshServer
        Else
            Exit Sub
        End If
    End If

End Sub

Private Sub OPC_ConnectBtn_Click()

    debugEvent "OPC - OPC_ConnectBtn_Click()"
    OPC_Connect
    OPC_LoopRead

End Sub

Sub OPC_DisconnectBtn_Click()

    debugEvent "OPC - OPC_DisconnectBtn_Click"
    OPC_Disconnect

End Sub

Sub OPC_Read_Once_Btn_Click()

    debugEvent "OPC - OPC_Read_Once_Btn_Click()"
    OPC_ReadOnce

End Sub


Sub status_update(status As String)
    debugEvent "OPC - status_update(" & status & ")"
    Cells(8, 2) = status
End Sub

Sub OPC_ReadOnce()

    debugEvent "OPC - OPC_ReadOnce()"
    OPC_Connect
    OPC_Read
    Time_Delay (1)
    OPC_Disconnect
    status_update ("Updated Tag Values Successfully")

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    'User input for time interval for main loop
    If (Not Intersect(Target, Range("C5:G65000")) Is Nothing) Or _
       (Not Intersect(Target, Range("A4:B8")) Is Nothing) Then
        If ThisWorkbook.connected = True Then
            MsgBox ("Please disconnect before changing any settings.")
        Exit Sub
        End If
    End If


End Sub

Answer 1

Options

选项显式变量必须声明

Option Explicit --要求变量声明是编写干净的VBA代码的第一步。但是，它不需要评论:注释应该说明为什么，而不是什么--任何一个查看Option语句的VBA程序员都会知道它的目的。而那些不这么做的人，可以在谷歌上搜索。

选项基1‘数组从索引1开始

同样的事情，评论基本上解释了声明的作用。但是，要小心Option Base，因为它往往会使事情变得混乱--众所周知，数组从索引0开始，集合从索引1开始。使用Option Base可以鼓励延迟数组声明--更好的做法是始终同时指定数组的下界和上限，并且在迭代数组时使用LBound和UBound。简而言之，我认为Option Base 1本身就是一种代码气味。

命名

VBA命名准则建议对所有东西都使用PascalCase，可能除了常量，即YELLCASE。不管你是否遵循这些准则，最重要的是一致性。以下是我自己的指导方针：

• PascalCase用于过程(Sub、Function、Property)、模块名(包括类名)，以及一般的任何公共标识符。
• 用于参数、局部变量和私有字段的camelCase。

现在VBA不区分大小写，所以适当和有意义的命名是至关重要的，否则您将不断地与IDE进行斗争。

说到有意义的名字：

Dim I作为整数Dim g作为整数Dim h作为整数i=1 To NumberOfTags

i的一个更好的名称可能是currentTag。实际上，i通常用作循环计数器，但是在有3个循环计数器的过程中，最好给它们取一个有意义的名称。

对于g=1到10000，如果不是IsEmpty(单元格(4+ g，4).value)

g的一个更好的名称可能是currentRow。

对于h=1到7模块1.(H)= False Next h

这个完全是神秘的。我们无法推断h的含义，也无法推断为什么它必须从1迭代到7。而且，SavedThisTime(h)看起来像是一个在标准模块中定义的公共字段(嗯，数组)--换句话说，一个全局变量，它可以和SavedThisTime(h)一样被引用，而没有Module1限定符.Module1也不是一个有用的名字。

德姆沃林

这是对的:消瘦。GrpName没有理由不被称为GroupName；大约20%的编程都是编写代码。另外的80%花在阅读代码上--也许还不如花点时间。

错误处理

Error_OpcConnectionFailure:

    OPC_Disconnect
    MsgBox ("Connection Failed:" & vbNewLine & vbNewLine & "Check Your server name and ensure RSLinx is Running.")
    Exit Sub


Error_TagNotFound:

    OPC_Disconnect
    MsgBox ("Connection Failed. Check tag: " & vbNewLine & vbNewLine & row_tag_name)
    Exit Sub

这两个子例程之间唯一的区别是它们传递给消息框的字符串。

一个过程应该只有一个On Error GoTo语句和一个错误处理子例程.

以Sub OPC_Connect()为例:因为连接失败而捕获一个错误，另一个因为找不到标记，闻起来:应该有一个负责连接的过程，另一个负责查找标记。

相反，On Error GoTo ErrHandler，或者我喜欢这样说，On Error GoTo CleanFail：

Public Sub Foo()
    On Error GoTo CleanFail

    '...

CleanExit:
    Exit Sub

CleanFail:
    'handle error
    Resume CleanExit
End Sub

现在，这个OPC_Connect过程通过显示一个消息框来处理这两种情况；我认为，在这种情况下，知道如何处理错误应该是调用代码的责任--处理程序可以做的是通过使用新的Source和Description值提高相同的错误号，尽可能提供信息。

Answer 2

如果不能够看到完整的代码，就很难理解正在发生的事情，所以我只能根据您共享的内容提供建议。以下是一些需要考虑的事项：

如果您编写Cells(4, 2)，这意味着ActiveSheet.Cells(4, 2)，那么如果您有更多的工作表，并且用户更改了active sheet ->，则会出现另一个值->错误。Sheets()也是如此，但不像Cells()/Range()那么重要。

可以在宏执行时冻结Excel；看看如何

您可以向每个Button_Click (UI事件处理程序，如OPC_DisconnectBtn_Click())添加一个错误处理程序。不管任何启动宏的用户操作到底出了什么问题，您都可以控制用户所看到的内容。

Answer 3

很好的答案。我有点惊讶神奇的数字问题没有被指出。一个神奇的数字在你的代码中几乎是任何数字常量，它的意义并不明显，而且对于任何看你代码的人来说，我指的是，而不仅仅是你。当代码中的数字符合这种描述时，很少有这样的情况，除了数组的下限(可能)、循环计数器的起始值或整数增量1 (iRow = iRow +1是可以的)。即使是像π这样的数字也可能不明显。只需将数字赋值给变量或常量即可。也就是说。

const PI = 3.14159265358979

在你的代码中

For h = 1 To 7
   Module1.SavedThisTime(h) = False
Next h

为什么是1比7？为什么不是2到17？这7个通道是数据吗？会一直是7点吗？相反，可以这样做：

Dim firstChannel as Long, lastChannel as Long, iChannel as Long
firstChannel = 1: lastChannel = 7
 ...
For iChannel = firstChannel to lastChannel
   Module1.SavedThisTime(iChannel) = False
Next h

这些台词也是一样的：

GrpName = Cells(5, 2)
'NumberOfTags = Cells(6, 2)
NumberOfTags = 0
status_update ("Adding Tags...")
For g = 1 To 10000
    If Not IsEmpty(Cells(4 + g, 4).value) Then
        NumberOfTags = NumberOfTags + 1

什么是细胞(5，2)？第5行或第2栏是否有特殊意义？10000只是一个任意大的数字或它代表10000秒？

表示行号和列号的神奇数字特别令人不安，因为总有一天有人(据Murphy说)可能会在工作表上插入额外的行或列。即使您知道已经发生了这种情况，挖掘您引用的第5行和第2列的所有位置也将是一项繁重的工作。

你可以创建一个范围变量，

Dim groupName as Range
Set groupRange = theSheet.Cells(5, 2)

一个更好的解决方案可能是创建一个命名范围，即在工作表上给它一个名称。如果您给出了指定的范围工作簿作用域(默认情况)，那么通过切换活动工作表或在第5行以上添加一行来从您下面拔出地毯的问题就会消失。所以而不是

GrpName = Cells(5, 2)

你会写

set groupName = Range("GroupName")

如果有人更改活动工作表或添加一行，甚至更改工作表的名称，groupName仍将指向其预期目标。

当我谈到用户(包括您自己)更改破坏代码的内容时，尽可能使用CodeNames而不是常规名称。您可以在VBA开发环境中将工作表CodeName设置为有意义的内容，但用户不能像更改工作表名称那样轻松地更改工作表名称。有关[这个]的更多信息，请参见CodeNames。