'操作狀態CommExit: 0=通訊進行狀態,>1=通訊被打斷
'通訊狀態CommEnd:0=開始發送和等待接收,>1:接收串已結束

'CommError=通訊出錯計數
'FxAddress=PLC映象地址計數

'FxString=存放每次PLC返回的應答串
'ErrStr=每串操作的結果提示,"OK" 或 "ERR"
'RowCo1=每次操作結果放在電子表格的填充區域

Public CommExit%, CommEnd%
Public CommError&, FxAddress&
Public FxString$, ErrStr$, RowCo1$

'將CommandButton1改名為Beginning,開始測試
Private Sub Beginning_Click()
Dim c As Range
Dim m1, m2
Dim s$, s1$, MaxLen&

On Error GoTo err1
CommPortOpen 1  '設置串口參數和打開端口
CommExit = 0
CommError = 0
Range("A1") = ""
Range(RowCo1) = ""
FxAddress = 0
RowCo1 = "a2:p257" '操作結果填寫在表格的區域
MaxLen = 16     '每次讀PLC映象的字節數
'遍歷讀FX-PLC映象區
For Each c In Range(RowCo1)
   '命令串轉換
   s = "0" & Right("000" & Hex(FxAddress), 4) & Hex(MaxLen)
   '指示正在讀入的區域
   c = Right("000" & Hex(FxAddress), 4) & ":"
   '清接收區殘余數據,和發命令
   s1 = MSComm1.Input
   MSComm1.Output = FxChar(s)
   
   FxString = ""  '清接收區
   CommEnd = 0    '置發送狀態
   c.Select    '焦點指向當前單元格
   
   m1 = Timer + 2 '限定等待時間2秒,超出后轉出錯并結束
   Do While CommExit = 0
       m2 = Timer
       If m2 > m1 Then
           MsgBox "通訊線路出錯!請檢查線路...", vbCritical
           MSComm1.PortOpen = False
           Exit Sub
       End If
       DoEvents    '交出VB事件處理控制權
   Loop
   
   '通訊被人工打斷
   If CommExit > 1 Then
       MsgBox "通訊被取消...", vbExclamation
       MSComm1.PortOpen = False
       Exit Sub
   End If
   DoEvents    '交出VB事件處理控制權
   WriteData (FxAddress)   '數據寫入"PLC數據"工作表
   c = c & ErrStr  '給出本輪通訊結果狀態
   FxAddress = FxAddress + MaxLen  '映象地址遷移
   If FxAddress > &HFFFF& Then
       MsgBox "讀入工作全部完成！", vbExclamation
       Exit For
   End If
   DoEvents    '交出VB事件處理控制權
Next
MSComm1.PortOpen = False
err1:
End Sub

'將CommandButton2改名為CancelB,打斷正在進行的通訊
Private Sub CancelB_Click()
CommExit = 3
End Sub

'在串口中斷中接收PLC返回的字串
Private Sub MSComm1_OnComm()
Dim s
Select Case MSComm1.CommEvent
   Case comEvReceive
       s = MSComm1.Input
       Select Case s
           Case Chr(6)
              CommEnd = 3
           Case Chr(21)
              CommEnd = 100
       End Select
       FxString = FxString & s
       If Len(FxString) >= 3 Then
           If Asc(Right(FxString, 3)) = 3 Then
               CommEnd = 5
           End If
       End If
       If CommEnd > 2 Then
         If CommEnd = 5 Then
             ErrStr = "OK"
         Else
             ErrStr = "ERR"
             CommError = CommError + 1
             Range("a1") = "出錯計數:" & CommError
         End If
         CommExit = 1
       End If
End Select
End Sub

'將PLC每次返回的數據填寫在"PLC數據"工作表里
Private Sub WriteData(n As Long)
Dim i&, j&
Dim s$
Static Row1%, Col1%
With Worksheets("PLC數據")
If n = 0 Then
   Row1 = 2
   Col1 = 0
   .Range(RowCo1) = ""
End If
.Range(Chr(&H61 + Col1) & Row1) = Right("000" & Hex(n), 4) _
   & ":" & FxString
If Chr(&H61 + Col1) = "p" Then
   Col1 = 0
   Row1 = Row1 + 1
Else
   Col1 = Col1 + 1
End If
FxString = ""
CommExit = 0
End With
End Sub


'將要發向PLC的命令字串組合:加起始符02h和結束符03h,及累加校驗和,返回給調用者
Private Function FxChar$(s$)
Dim m%, n%
Dim s1$
s1 = UCase(s)
For m = 1 To Len(s1)
   n = n + Asc(Mid(s1, m, 1))
Next
n = n + 3
FxChar = Chr(2) & s1 & Chr(3) & Right(Hex(n), 2)
End Function

'設置通訊口參數后,打開通訊口
Private Sub CommPortOpen(Port%)
If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
End If
MSComm1.CommPort = Port
MSComm1.Settings = "9600,e,7,1"
MSComm1.RTSEnable = True
MSComm1.InputMode = comInputModeText
MSComm1.SThreshold = 1
MSComm1.PortOpen = True
End Sub