vb中怎么将串口接收的数据串添加到excel中并保存

Question

vb中怎么将串口接收的数据串 例： FA 3E 00 00 00 00 00 00 00 00 将这组数据添加到Excel中A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 接收的第二条就放在A2.......J2中 一次类推 并且将16进制转化成10进制 保存输出

Answer 1

以前做某个项目，为此专门写过一个转换库,可以方便把16进制和10进制互转。

1. vb数据转换成16进制字符串的转换函数。

Function WordToStrHex(wordVal As String) As String

Function CheckSum(strHex As String) As String

Function DWordToStrHex(dwordVal As String) As String

Function FloatToStrHex(floatVal As String) As String

Function IntegerToStrHex(intVal As String) As String

Function ShortToStrHex(shortVal As String) As String

Function WordToStrHex(wordVal As String) As String

2. 16进制字符串转换vb数据的转换函数

Function StrHexToDWord(strHex As String) As String

Function StrHexToFloat(strHex As String) As String

Function StrHexToInteger(strHex As String) As String

Function StrHexToShort(strHex As String) As String

Function StrHexToWord(strHex As String) As String

3  至于输出到excel，你参考下面的代码。

'把flexgrid数据导出到excel

Sub sub_FlgDataToExcel(iStartCol As Integer, Optional sTitle = "", Optional sFileName = "")

Screen.MousePointer = vbHourglass

Dim oXl As Excel.Application

Dim oWb As Workbook

Dim oWs As Excel.Worksheet

Dim iA, iB, iC, id

Dim bExcelRunning    'Excel是否已运行

Dim flg As MSFlexGrid

Dim sStr

On Error GoTo Morn

bExcelRunning = True     '同首先用的GetObject一致:假设Excel已运行

Set oXl = GetObject("", "Excel.Application")

Set oWb = oXl.Workbooks.Add

Set oWs = oWb.Worksheets(1)

Set flg = Screen.ActiveForm.flg

With oWs

    oXl.DisplayAlerts = False '禁止提示

     oWs.Cells.HorizontalAlignment = 3 '//居中问题

     oWs.Cells.VerticalAlignment = 3

  For iB = 1 To flg.cols - iStartCol

      .Cells(1, iB) = sTitle

      .Cells(2, iB).Value = flg.TextMatrix(0, iB - 1 + iStartCol)

       .Columns(iB).ColumnWidth = flg.ColWidth(iB - 1 + iStartCol) / 100

  Next

  .Range(.Cells(1, 1), .Cells(1, flg.cols - iStartCol)).MergeCells = True

  For iC = 2 To flg.Rows - 1

        For iB = 1 To flg.cols - iStartCol

         sStr = Trim(flg.TextMatrix(iC, iB + iStartCol - 1))

         If IsNumeric(sStr) Then

            .Cells(iC + 1, iB).Value = sStr

         Else

            '截取尾部的数字

            If IsNumeric(Right(sStr, 1)) Then sStr = Left(sStr, Len(sStr) - 1)

            If IsNumeric(Right(sStr, 1)) Then sStr = Left(sStr, Len(sStr) - 1)

            .Cells(iC + 1, iB).Value = sStr

         End If

        Next

    Next

End With

oWs.Parent.Names.Add "CostRange", "=" & "A1:B39"

If sFileName = "" Then

   sFileName = Morn.Fun_GetLocalTime(1)

End If

sStr = App.Path & "\" & sFileName & ".xls"

oWs.SaveAs sStr

end sub