还是发代码吧，不习惯对着图片分析代码。

Sub send_information()
    send_data =h1 &g1 &f1 &e1 &d1 &c1 & b1 & a1
    For i = 1 To Len(send_data)
        a = a + CLng(Mid$(send_data, i, 1)) * 2 ^ CLng(Len(send_data) - i)
    Next i
    If a < 16 Then
       data = 0 & Hex(a)
    Else
       data = Hex(a)
    End If
    Hexdata = "&H" & Mid(Data, 1, 2)
    addnum = Hex(&H2 + &H7C + &H32 + &H1 + &HE + &H5 + &H5 + &H1 + &H12 + &HA + &H10 + &H2 + &H1 + &H82 + &H4 + &H8 + Hexdata)
    checkdata = Right(addnum, 2)
    Dim temp As String
    Dim n As Integer
    Dim arr() As Byte
    temp = "6820206802007C320100000000000E000501120A1002000100008200000000040008" & Data & checkdata & " 16 "
    n = Len(temp) \ 2 - 1
    For i = 0 To n
        arr(i) = Val("&H" & Mid(temp, i * 2 + 1, 2))
    Next i
    MSComm1.Output = arr
End Sub

先在这里谢谢🙏了

Sub send_information()
    send_data =h1 &g1 &f1 &e1 &d1 &c1 & b1 & a1
    For i = 1 To Len(send_data)
        a = a + CLng(Mid$(send_data, i, 1)) * 2 ^ CLng(Len(send_data) - i)
    Next i
    If a < 16 Then
       data = 0 & Hex(a)
    Else
       data = Hex(a)
    End If
    Hexdata = "&H" & Mid(Data, 1, 2)
    addnum = Hex(&H2 + &H7C + &H32 + &H1 + &HE + &H5 + &H5 + &H1 + &H12 + &HA + &H10 + &H2 + &H1 + &H82 + &H4 + &H8 + Hexdata)
    checkdata = Right(addnum, 2)
    Dim temp As String
    Dim n As Integer
    Dim arr() As Byte
    temp = "6820206802007C320100000000000E000501120A1002000100008200000000040008" & Data & checkdata & " 16 "
    n = Len(temp) \ 2 - 1
    For i = 0 To n
        arr(i) = Val("&H" & Mid(temp, i * 2 + 1, 2))
    Next i
    MSComm1.Output = arr
End Sub

arr数组没有定义大小，下标越界,在下面语句间增加数组重定义
  n = Len(temp) \ 2 - 1
  ReDim arr(n) '增加数组重定义
  For i = 0 To n

谢谢🙏