以下代码为原创，实践验证过

Public Function r_data(add As Byte, ty As String, firsth As Byte, firstl As Byte, total As Byte) As String  '读MODBUS数据
On Error GoTo a:

        ReDim CRC(1) As Byte
        Dim FGetData As String
        ReDim a(5) As Byte
        Dim m As Integer
        Dim x As Integer
        Dim aa1 As Byte
        Dim e As Byte
        x = Me.comm_RS_time
     
        Select Case ty                          '判断寄存器类型
          Case "AI"              '读输入寄存器数值
            a(1) = "&h" & Hex(4)
          Case "DI"              '读输入线圈状态
            a(1) = "&h" & Hex(2)
          Case "HR"              '读保持寄存器数据
            a(1) = "&h" & Hex(3)
          Case "C"               '读输出线圈状态
            a(1) = "&h" & Hex(1)
         End Select
        
        a(0) = "&h" & Hex(add)
       
        a(2) = "&h" & Hex(firsth)
        a(3) = "&h" & Hex(firstl)
        a(4) = "&h" & Hex(0)
        a(5) = "&h" & Hex(total)

          CRC = CRC16(a)                         '调用CRC16计算函数
         'CRC(0)为高位
         'CRC(1)为低位
        ReDim Preserve a(0 To 7) As Byte
        a(6) = "&h" & Hex(CRC(1))
        a(7) = "&h" & Hex(CRC(0))
        MSComm1.Output = a
        Do
          DoEvents
        Loop Until MSComm1.OutBufferCount = 0    '等待，直到数据发送完毕
        Sleep (x)
       
         Select Case ty
          Case "AI"
            m = total * 2 + 5
          Case "DI"
            m = total \ 8
            aa1 = total Mod 8
            If aa1 > 0 Then
               m = m + 1
            End If
            m = m + 5                             '计算串口应该返回的字节数
          Case "HR"
            m = total * 2 + 5
          Case "C"
            m = total \ 8
            aa1 = total Mod 8
            If aa1 > 0 Then
               m = m + 1
            End If
            m = m + 5                             '计算串口应该返回的字节数
         End Select
         
        FGetData = ReceiveData(m)
        If Len(FGetData) <> m * 2 Then            '接收的字节数不对
          Me.comm_fault = True                       '通信失败标志位置位
          r_data = ""
          Exit Function
        Else                                      'CRC校验
            ReDim y(0 To m - 3) As Byte
            Dim i As Integer
          For i = 0 To m - 3
            y(i) = "&h" & Hex(Hex_Dec(Mid(FGetData, (i + 1) * 2 - 1, 2)))
          Next
           
            CRC = CRC16(y)                        '调用CRC16计算函数
            ReDim Preserve y(0 To m - 1) As Byte
            y(m - 2) = "&h" & Hex(CRC(1))
            y(m - 1) = "&h" & Hex(CRC(0))
            If y(m - 2) <> "&h" & Hex(Hex_Dec(Mid(FGetData, (m - 1) * 2 - 1, 2))) Or y(m - 1) <> "&h" & Hex(Hex_Dec(Mid(FGetData, m * 2 - 1, 2))) Then
               r_data = ""
               GoTo mm1                           'CRC校验失败
            End If
         End If
   
          e = Hex_Dec(Mid(FGetData, 5, 2))
          r_data =ｍｉｄ（FGetData, 7, e * 2)        '返回接收的数据
          Erase CRC, a, y
  mm1:
      Erase CRC, a, y
     
Exit Function

a:
   If Err.Number <> 0 Then
      MsgBox Err.Description
   End If
End Function

暮色大侠，粗看一下，你的程式没有整数转浮点数的程序。没有波特率选择，没有校验选择，没有停止位。

也许俺笨，你能不能做这样的程式：画面做一个显示框用来显示40001的浮点数，一个输入框用来控制40003的浮点数，一个指示灯用来显示00001的位，一个开关用来控制00003的位。发VB原程式到我邮箱好吗？SJBO_2003@163.com

Modbus通信协议&VB测试程序
 协议内容:http://download.gongkong.com/file/2005/6/13/Modbus.pdf

VB测试程序：

Option Explicit
Private Text1text As String
Private RTUCRC As String
'串口选择
Private Sub Combo1_Click()
              MSComm1.CommPort = Combo1.ListIndex + 1
End Sub
'数据位改变
Private Sub Combo2_Click()
        Call setting
End Sub
'波特率改变
Private Sub Combo3_Click()
        Call setting
End Sub
'奇偶校验改变
Private Sub Combo4_Click()
        Call setting
End Sub
'停止位改变
Private Sub Combo5_Click()
        Call setting
End Sub
Private Sub setting()
         MSComm1.Settings = CStr(Combo3.Text) & "," & CStr(Combo4.Text) & "," & CStr(Combo2.Text) _
                                          & "," & CStr(Combo5.Text)
End Sub
'打开关闭串口
Private Sub Command1_Click()
        On Error Resume Next
        If MSComm1.PortOpen = False Then
            MSComm1.PortOpen = True
        Else
               MSComm1.PortOpen = False
        End If
       
        If MSComm1.PortOpen Then                                '打开关闭按钮显示文字及combo1使能
             Command1.Caption = "关闭串口"
             Combo1.Enabled = False
        Else
              Command1.Caption = "打开串口"
              Combo1.Enabled = True
        End If
       
          If Err Then                                                          '打开串口失败，则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
'10转16进制
Private Sub Command2_Click(Index As Integer)
     On Error Resume Next
         Text4.Text = Hex(Text3.Text)
           If Err Then                                                          ''则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
'16转10进制
Private Sub Command3_Click()
         Dim a As Long
         a = Val("&H" & CStr(Text4.Text))
         Text3.Text = a
End Sub
'手动串口发送
Private Sub Command4_Click()
         If MSComm1.PortOpen = False Then
                  MsgBox "请先打开串口", , "错误信息"
                  Exit Sub
          End If
          Call sentsub
End Sub
'清除接收窗
Private Sub Command5_Click()
          Text2.Text = ""
End Sub
Private Sub Command6_Click()
        Unload Me
End Sub
Private Sub Command7_Click()
        On Error Resume Next
          Dim STP As String
           STP = CStr(Chr(2)) & "010001" & CStr(Chr(3)) & "25"
           MSComm1.Settings = "9600,N,7,2"
           MSComm1.PortOpen = True
           MSComm1.Output = STP
           MSComm1.PortOpen = False
           If Err Then                                                          '打开串口失败，则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
Private Sub Command8_Click()
        On Error Resume Next
        Dim FWD As String
           FWD = CStr(Chr(2)) & "010101" & CStr(Chr(3)) & "26"
           MSComm1.Settings = "9600,N,7,2"
           MSComm1.PortOpen = True
           MSComm1.Output = FWD
           MSComm1.PortOpen = False
           If Err Then                                                          '打开串口失败，则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
Private Sub Command9_Click()
        On Error Resume Next
           Dim REV As String
           REV = CStr(Chr(2)) & "010201" & CStr(Chr(3)) & "27"
           MSComm1.Settings = "9600,N,7,2"
           MSComm1.PortOpen = True
           MSComm1.Output = REV
           MSComm1.PortOpen = False
           If Err Then                                                          '打开串口失败，则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
'窗口加载
Private Sub Form_Load()
         Dim d%
            For d = 1 To 16
                   Combo1.AddItem ("COM" & CStr(d))
            Next
                   Combo1.ListIndex = 0
                  
            Combo2.AddItem "6"
            Combo2.AddItem "7"
            Combo2.AddItem "8"
            Combo2.ListIndex = 2
           
            Combo3.AddItem "110"
            Combo3.AddItem "330"
            Combo3.AddItem "1200"
            Combo3.AddItem "2400"
            Combo3.AddItem "4800"
            Combo3.AddItem "9600"
            Combo3.AddItem "19200"
            Combo3.AddItem "38400"
            Combo3.AddItem "56000"
            Combo3.AddItem "57600"
            Combo3.AddItem "115200"
            Combo3.ListIndex = 5
           
            Combo4.AddItem "n"
            Combo4.AddItem "o"
            Combo4.AddItem "e"
            Combo4.ListIndex = 0
           
            Combo5.AddItem "1"
            Combo5.AddItem "2"
            Combo5.ListIndex = 0
           
            For d = 0 To 254
                Combo6.AddItem d
            Next
                Combo6.ListIndex = 1
           
         Text1.Text = "010601001770"
         Text2.Text = ""
         Text3.Text = ""
         Text4.Text = ""
         Text5.Text = "1000"
         Text6.Text = "06"
         Text7.Text = "0"
         Text8.Text = "1"
        
         Option1.value = True
         Option3.value = True
         Option7.value = True
         Option9.value = True
        
         If MSComm1.PortOpen = False Then
                Command1.Caption = "打开串口"
         Else
                Command1.Caption = "关闭串口"
         End If
End Sub
'串口接收程序
Private Sub MSComm1_OnComm()
        Dim Hexｃｈｒ　As String, hexstring As String, i As Integer, j As Integer, hexdisp As String
        If Option8.value Then
             hexstring = MSComm1.Input                                                                    '十六进制显示
            i = Len(hexstring)
             For j = 1 To i
                 Hexｃｈｒ　=ｍｉｄ（hexstring, j, 1)
                 If Hex(Asc(Hexchr)) < 16 Then
                    Text2.Text = Text2.Text & "0" & Hex(Asc(Hexchr)) & " "
                 Else
                    Text2.Text = Text2.Text & Hex(Asc(Hexchr)) & " "
                End If
            Next j
            Text2.Text = Text2.Text & CStr(Chr(13)) & CStr(Chr(10))
        Else
            Text2.Text = Text2.Text & MSComm1.Input & CStr(Chr(13)) & CStr(Chr(10))   'ASCII码显示
        End If
End Sub
'手动发送选择
Private Sub Option1_Click()
         If Option1.value = True Then
              Timer1.Enabled = False
              Command4.Enabled = True
        Else
              Timer1.Enabled = True
              Command4.Enabled = False
        End If
End Sub
'Delta ASCII发送协议
Private Sub Option10_Click()
        Combo6.Enabled = True
       Text6.Enabled = True
       Text7.Enabled = True
       Text8.Enabled = True
       Label10.Enabled = True
       Label11.Enabled = True
       Label12.Enabled = True
       Label13.Enabled = True
       Option6.Enabled = False
       Option7.Enabled = False
       Option11.value = True
       Combo2.ListIndex = 1
       Combo5.ListIndex = 1
       Text1.Enabled = False
       Label14.Enabled = False
       Frame7.Visible = True
End Sub

'自动发送选择
Private Sub Option2_Click()
         If Option2.value = True Then
              Timer1.Enabled = True
              Command4.Enabled = False
        Else
              Timer1.Enabled = False
              Command4.Enabled = True
        End If
End Sub
Private Sub Option3_Click()               'Non选项
       Combo6.Enabled = False
       Text6.Enabled = False
       Text7.Enabled = False
       Text8.Enabled = False
       Label10.Enabled = False
       Label11.Enabled = False
       Label12.Enabled = False
       Label13.Enabled = False
       Option6.Enabled = True
       Option7.Enabled = True
       Combo2.ListIndex = 2
       Combo5.ListIndex = 0
       Text1.Enabled = True
       Label14.Enabled = True
       Frame7.Visible = False
End Sub
Private Sub Option4_Click()               'ASCII选项
       Combo6.Enabled = True
       Text6.Enabled = True
       Text7.Enabled = True
       Text8.Enabled = True
       Label10.Enabled = True
       Label11.Enabled = True
       Label12.Enabled = True
       Label13.Enabled = True
       Option6.Enabled = False
       Option7.Enabled = False
       Combo2.ListIndex = 1
       Combo5.ListIndex = 1
       Text1.Enabled = False
       Label14.Enabled = False
       Frame7.Visible = False
End Sub
Private Sub Option5_Click()               'RTU选项
       Combo6.Enabled = True
       Text6.Enabled = True
       Text7.Enabled = True
       Text8.Enabled = True
       Label10.Enabled = True
       Label11.Enabled = True
       Label12.Enabled = True
       Label13.Enabled = True
       Option6.Enabled = False
       Option7.Enabled = False
       Combo2.ListIndex = 2
       Combo5.ListIndex = 1
       Text1.Enabled = False
       Label14.Enabled = False
       Frame7.Visible = False
End Sub
'发送时间间隔调整输入
Private Sub Text5_Change()
        Dim number As String
        Dim num As Integer
        Dim numcyc As Integer
        num = Len(Text5.Text)
        For numcyc = 1 To num
            number =ｍｉｄ（Text5.Text, numcyc, 1)
            Select Case InStr("0123456789", number)
            Case 0
               MsgBox "输入时间间隔错误，请重新输入", , "错误信息"
               Exit Sub
            End Select
        Next
         Timer1.Interval = Text5.Text
End Sub
'自动发送定时器
Private Sub Timer1_Timer()
         If MSComm1.PortOpen Then
               Call sentsub
         End If
End Sub
'状态刷新定时器
Private Sub Timer2_Timer()
         StatusBar1.Panels(1).Text = "串口选择：" & CStr(Combo1.Text)
         StatusBar1.Panels(2).Text = "串口设置：" & CStr(MSComm1.Settings)
         StatusBar1.Panels(3).Text = "串口状态：" & CStr(MSComm1.PortOpen)
End Sub
'串口发送子程序
Private Sub sentsub()
             Dim optioncase%
             If Option3.value Then optioncase = 1
             If Option4.value Then optioncase = 2
             If Option5.value Then optioncase = 3
             If Option10.value Then optioncase = 4
             Select Case optioncase
             Case 1
                     If Option6.value Then
                       Text1text = Text1.Text
                       Call Hexsent
                     Else
                       Text1text = Text1.Text
                       Call ASCIIsent
                     End If
             Case 2
                  Call incorporate                '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
                  Call ASCIIcheck
                  Call ASCIIsent
             Case 3
                  Call incorporate                 '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
                  Call RTUcheck
                  Call Hexsent
             Case 4
                  Call incorporate1                '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
                  Call deltaASCII
                  Call ASCIIsent
            End Select
End Sub
'十六进制发送
Private Sub Hexsent()
            Dim hexchrlen%, Hexｃｈｒ　As String, hexcyc%, hexｍｉｄAs Byte, hexmiddle As String
            Dim hexchrgroup() As Byte, i As Integer
               hexchrlen = Len(Text1text)
               For hexcyc = 1 To hexchrlen                                                  '检查Text1文本框内数值是否合适
               Hexｃｈｒ　=ｍｉｄ（Text1text, hexcyc, 1)
               If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
                     MsgBox "无效的数值，请重新输入", , "错误信息"
                     Exit Sub
                End If
               Next
               ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
               For hexcyc = 1 To hexchrlen Step 2                                         '将文本框内数值分成两个、两个
                     i = i + 1
                     Hexｃｈｒ　=ｍｉｄ（Text1text, hexcyc, 2)
                     hexｍｉｄ= Val("&H" & CStr(Hexchr))
                     hexchrgroup(i) = hexmid
                     'MSComm1.Output = CStr(hexmid)
               Next
               MSComm1.Output = hexchrgroup
End Sub
'ASC码发送
Private Sub ASCIIsent()
                MSComm1.Output = Text1text
End Sub
'ASC校验,此段程序计算出LRC校验值，并加上字头和字尾
Private Sub ASCIIcheck()
         Dim a%, b%, chrnum%, Lrcbyte As String
         Dim checksum%, char%, AscLrc%, Lrc%
        
         chrnum = Len(Text1text)
         For a = 1 To chrnum Step 2
            ｃｈａｒ　= Val("&H" & CStr(Mid(Text1text, a, 2)))   '两个两个的取字符
            checksum = checksum + char                      '全部加起来
         Next
         AscLrc = checksum Mod &H100                        '取255的余数
         Lrc = (&HFF - AscLrc) + 1                                '取二次补
         If Lrc < 16 Then                                               '此段程序是判断Hex(lrc)是否是一位数，
             Lrcbyte = "0" + CStr(Hex(Lrc))                     '如果是的话，前面加0；否则不加零
        Else
            Lrcbyte = CStr(Hex(Lrc))
        End If
         Text1text = CStr(Chr(58)) & CStr(Text1text) & Lrcbyte & CStr(Chr(13)) & CStr(Chr(10))
End Sub
'DeltaASCII校验,此段程序计算出LRC校验值，并加上字头和字尾
Private Sub deltaASCII()
         Dim a%, b%, chrnum%, Lrcbyte As String
         Dim checksum%, char%, Lrc%
                 
         chrnum = Len(Text1text)
         For a = 1 To chrnum
            ｃｈａｒ　= Asc(Mid(Text1text, a, 1))   '两个两个的取字符
            checksum = checksum + char                      '全部加起来
         Next
         Lrc = (checksum + &H3) Mod &H100                       '取255的余数
         If Lrc < 16 Then                                               '此段程序是判断Hex(lrc)是否是一位数，
             Lrcbyte = "0" + CStr(Hex(Lrc))                     '如果是的话，前面加0；否则不加零
        Else
            Lrcbyte = CStr(Hex(Lrc))
        End If
         Text1text = CStr(Chr(2)) & CStr(Text1text) & CStr(Chr(3)) & Lrcbyte
End Sub
'RTU校验
Private Sub RTUcheck()
        Dim CRC() As Byte
        Dim d(5) As Byte
        Dim string1 As String
        Dim j As Integer, chrlength As Integer, temp As String
       
        string1 = Text1text
        chrlength = Len(string1)
        For j = 0 To chrlength / 2 - 1
                  temp =ｍｉｄ（string1, j * 2 + 1, 2)
                  d(j) = Val("&H" & temp)
        Next
        RTUCRC = CRC16(d)                         '调用CRC16计算函数, CRC(0)为高位,  CRC(1)为低位
        Text1text = Text1text & RTUCRC
End Sub
Private Sub incorporate()                                       '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
       Dim wholeｃｈａｒ　As String, wc%, wcyc%, wｃｈａｒ　As String
       Dim SID As String, Cmd As String, InfoAdd As String, data As String
       Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
      
      On Error Resume Next
        wholeｃｈａｒ　= CStr(Combo6.Text) & CStr(Text6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
        wc = Len(wholechar)
        For wcyc = 1 To wc
            wｃｈａｒ　=ｍｉｄ（wholechar, wcyc, 1)
            If InStr("0123456789", wchar) = 0 Then
                MsgBox "输入错误，请重新输入", , "错误提示"
                Exit Sub
            End If
        Next

             SIDnum = Len(CStr(Hex(Combo6.Text)))
              Select Case SIDnum
              Case 0
                Exit Sub
             Case 1
                 SID = "0" & CStr(Hex(Combo6.Text))
             Case 2
                 SID = CStr(Hex(Combo6.Text))
             End Select

             Cmdnum = Len(CStr(Hex(Text6.Text)))
             Select Case Cmdnum
             Case 0
                Exit Sub
             Case 1
                  Cmd = "0" & CStr(Hex(Text6.Text))
             Case 1
                  Cmd = CStr(Hex(Text6.Text))
             End Select
            
             InfoAddNum = Len(CStr(Hex(Text7.Text)))
             Select Case InfoAddNum
             Case 0
                Exit Sub
             Case 1
                  InfoAdd = "000" & CStr(Hex(Text7.Text))
             Case 2
                  InfoAdd = "00" & CStr(Hex(Text7.Text))
             Case 3
                  InfoAdd = "0" & CStr(Hex(Text7.Text))
             Case 4
                  InfoAdd = CStr(Hex(Text7.Text))
            End Select
                 
             Datanum = Len(CStr(Hex(Text8.Text)))
             Select Case Datanum
             Case 0
                Exit Sub
             Case 1
                  data = "000" & CStr(Hex(Text8.Text))
             Case 2
                  data = "00" & CStr(Hex(Text8.Text))
             Case 3
                  data = "0" & CStr(Hex(Text8.Text))
             Case 4
                  data = CStr(Hex(Text8.Text))
            End Select
           
           If Err Then                                                          '显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
            Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
End Sub
Private Sub incorporate1()                                       '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
       Dim wholeｃｈａｒ　As String, wc%, wcyc%, wｃｈａｒ　As String
       Dim SID As String, Cmd As String, InfoAdd As String, data As String
       Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
      
      On Error Resume Next
        wholeｃｈａｒ　= CStr(Combo6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
        wc = Len(wholechar)
        For wcyc = 1 To wc
            wｃｈａｒ　=ｍｉｄ（wholechar, wcyc, 1)
            If InStr("0123456789", wchar) = 0 Then
                MsgBox "输入错误，请重新输入", , "错误提示"
                Exit Sub
            End If
        Next

             SIDnum = Len(CStr(Hex(Combo6.Text)))
              Select Case SIDnum
              Case 0
                Exit Sub
             Case 1
                 SID = "0" & CStr(Hex(Combo6.Text))
             Case 2
                 SID = CStr(Hex(Combo6.Text))
             End Select

            'Cmdnum = Len(CStr(Hex(Text6.Text)))
             'Select Case Cmdnum
             'Case 0
             '   Exit Sub
             'Case 1
             '     Cmd = "0" & CStr(Hex(Text6.Text))
             'Case 1
             '     Cmd = CStr(Hex(Text6.Text))
             'End Select
            
             InfoAddNum = Len(CStr(Hex(Text7.Text)))
             Select Case InfoAddNum
             Case 0
                Exit Sub
             Case 1
                  InfoAdd = "0" & CStr(Hex(Text7.Text))
             Case 2
                  InfoAdd = CStr(Hex(Text7.Text))
            End Select
                 
             Datanum = Len(CStr(Hex(Text8.Text)))
             Select Case Datanum
             Case 0
                Exit Sub
             Case 1
                  data = "000" & CStr(Hex(Text8.Text))
             Case 2
                  data = "00" & CStr(Hex(Text8.Text))
             Case 3
                  data = "0" & CStr(Hex(Text8.Text))
             Case 4
                  data = CStr(Hex(Text8.Text))
            End Select
           
           If Err Then                                                          '显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
           
            If Option11.value Then
                  Cmd = "08"
                  Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd)
             Else
                  Cmd = "07"
                  Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
            End If
           
End Sub
Private Function CRC16(data() As Byte) As String
      Dim CRC16Lo As Byte, CRC16Hi As Byte      'CRC寄存器
      Dim CL As Byte, CH As Byte                '多项式码&HA001
      Dim CRCLo As String, CRCHi As String
      Dim SaveHi As Byte, SaveLo As Byte
      Dim i As Integer
      Dim Flag As Integer
      CRC16Lo = &HFF
      CRC16Hi = &HFF
      CL = &H1
      CH = &HA0
      For i = 0 To UBound(data)
        CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
        For Flag = 0 To 7
          SaveHi = CRC16Hi
          SaveLo = CRC16Lo
          CRC16Hi = CRC16Hi \ 2            '高位右移一位
          CRC16Lo = CRC16Lo \ 2            '低位右移一位
          If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
            CRC16Lo = CRC16Lo Or &H80      '则低位字节右移后前面补1
          End If                           '否则自动补0
          If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
            CRC16Hi = CRC16Hi Xor CH
            CRC16Lo = CRC16Lo Xor CL
          End If
        Next Flag
      Next i
      If Len(Hex(CRC16Hi)) = 1 Then
         CRCHi = "0" + Hex(CRC16Hi)
      Else
         CRCHi = Hex(CRC16Hi)
      End If
      If Len(Hex(CRC16Lo)) = 1 Then
         CRCLo = "0" + Hex(CRC16Lo)
      Else
         CRCLo = Hex(CRC16Lo)
      End If
         CRC16 = CRCLo + CRCHi
  End Function

这是工控网上另一牛人编的，我试了半天也试不出来，不过可用做大侠您参考。

MODBUS名称有点吓人，其实很简单，就是串行通讯对话，一要知道通讯格式，很简单，

可以搜到；二，计算校验码，也可以找到；

各位大侠人呢？帖子不能沉呀，555555555555555

可以看看我的软件- Modbus,支持OPC ,内含Modbus驱动,能够进行数据类型转换.

在VB里实现浮点数据转换比较困难,建议通过c语言实现,通过dll或控件方式调用.

c语言如下:

 case DT_R4:
  { //4字节实数－－－－已经调试过20061113
   //4字节实数－－－－－－－－－－-CCommData::DF_HV2143(默认)

   ToDataBuf(cByte,4,pBuf);

   float* pfValue = (float*)&cByte[0];
   strValue.Format(_T("%f"),*pfValue);
   
   return strValue;
   break;
   ／＊
    //3.57200 
    //0x9b    0xa6    0x40    0x64
    //HV2 HV1 HV4 HV3
    unsigned ｃｈａｒ　cByte[5];
    cByte[0]=0xa6;
    cByte[1]=0x9b;
    cByte[2]=0x64;
    cByte[3]=0x40;
    cByte[4]='\0';
    pfValue=(float*)&cByte[0];
   /／＊/

  }

难点在于浮点数转换

vc中浮点数转换可以通过union来实现union { float f; unsigned ｃｈａｒ　b[4]; } u;  也可以通过指针强制转化实现。

在VB很难实现union结构，可以通过CopyMemory(API函数)实现指针强制转化。

例如：

     dim f as single

    dim b[4] as byte

     CopyMemory f,b,4
或
  CopyMemory ByVal(VarPtr(f)+0),b(0),1
  CopyMemory ByVal(VarPtr(f)+1),b(1),1
  CopyMemory ByVal(VarPtr(f)+2),b(2),1
  CopyMemory ByVal(VarPtr(f)+3),b(3),1

在VB中浮点数转换也是比较简单的，定义两个自定义类型，用Lset，其实原理和CopyMemory是一样

只有源码 没有界面

都在不知道怎么用VB编译啊

谁有完整的 可以用VB打开的