=========================================================================================

Private Sub Command4_Click()     On Error Resume Next  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''Create Excel Table''''''''''''''''''''''''''''''''''''''''''        Dim xlApp As Excel.Application         Dim xlBook As Excel.Workbook         Dim xlSheet As Excel.Worksheet         Dim xlSheet1 As Excel.Worksheet         Dim i As Integer, tmHour As String         ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''         On Error Resume Next                        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''        Set xlApp = Excel.Application        Set xlBook = xlApp.Workbooks.Add         'xlBook.Activate        Set xlSheet = xlBook.Worksheets(1) '''''''''''''''''''''''''''''''''引用第1张工作表             xlApp.ActiveSheet.Rows.VerticalAlignment = xlVAlignCenter '''''垂直方向居中             xlApp.ActiveSheet.Rows.HorizontalAlignment = xlVAlignCenter '''水平方向居中             xlSheet.Name = "实测值"          Set xlSheet1 = xlBook.Worksheets(2)          xlSheet1.Name = "Chart"        With xlSheet              For i = 2 To 11                 .Range(Cells(1, 1), Cells(1, i)).Merge ''''''''''''''''''''合并A-K单元格              Next             ' .Cells(1, 1).ForeColor = RGB(100, 150, 255)              .Cells(1, 1).Font.Size = 25                            ''''''''''''''''''''''''''设置行高'设置列宽              For i = 1 To 22                 .Rows(i).RowHeight = 25              Next              For i = 1 To 11               .Columns(i).ColumnWidth = 15              Next              '''''''''''''''''''''''''''合并单元格              For i = 3 To 22                                      If i < 8 Then                         .Range(Cells(3, 1), Cells(i, 1)).Merge '''''''''''合并A3-A7单元格                         .Range(Cells(3, 8), Cells(i, 8)).Merge '''''''''''合并H3-H7单元格                    ElseIf i < 13 Then                         .Range(Cells(8, 1), Cells(i, 1)).Merge                         .Range(Cells(8, 8), Cells(i, 8)).Merge                    ElseIf i < 18 Then                         .Range(Cells(13, 1), Cells(i, 1)).Merge                         .Range(Cells(13, 8), Cells(i, 8)).Merge                    ElseIf i < 23 Then                         .Range(Cells(18, 1), Cells(i, 1)).Merge                         .Range(Cells(18, 8), Cells(i, 8)).Merge                    End If              Next              ''''''''''''''''''''''''''''''''''''''''''''             .Range("A1", "K22").Borders.LineStyle = xlContinuous '''''''单元格边框             .Range("A1", "K22").Borders.Color = vbBlue '''''''''''''''''边框颜色             .Range("A1", "K22").Interior.Color = RGB(100, 180, 0) ''''''区域 背景色                          ''''''''''''''''''''''''''''''             .Range("A1").Value = "iWatt 项目"             .Range("A1").Font.Color = vbRed ''''''''''''''设置字体颜色             .Range("A1").Font.Name = "楷书" ''''''''''''''设置字体字型             .Range("A1").Font.Size = 30 ''''''''''''''''''设置字体字号              '''''''''''''''''''''''''''''''''''''''             .Range("A2").Value = "输入电压(VAC)"             .Range("B2").Value = "输入功率(W)"             .Range("C2").Value = "输出电压(V)"             .Range("D2").Value = "输出电流mA)"             .Range("E2").Value = "输出功率(W)"             .Range("F2").Value = "纹波电压(A)"             .Range("G2").Value = "效率(%)"             .Range("H2").Value = "过流点(A)"             .Range("I2").Value = "初级到次级功率损耗(W)"             .Range("J2").Value = "平均功率%"             .Range("K2").Value = "需符合CEC标准"             '''''''''''''''''''''''''''''''''''电压值             .Range("A3").Value = "90"             .Range("A8").Value = "115"             .Range("A13").Value = "230"             .Range("A18").Value = "264"             '''''''''''''''''''''''''''''''''''负载值                          .Range("D3").Value = "0"             .Range("D4").Value = "1/4 Load"             .Range("D5").Value = "2/4 Load"             .Range("D6").Value = "3/4 Load"             .Range("D7").Value = "Full Load"             .Range("D8").Value = "0"             .Range("D9").Value = "1/4 Load"             .Range("D10").Value = "2/4 Load"             .Range("D11").Value = "3/4 Load"             .Range("D12").Value = "Full Load"             .Range("D13").Value = "0"             .Range("D14").Value = "1/4 Load"             .Range("D15").Value = "2/4 Load"             .Range("D16").Value = "3/4 Load"             .Range("D17").Value = "Full Load"             .Range("D18").Value = "0"             .Range("D19").Value = "1/4 Load"             .Range("D20").Value = "2/4 Load"             .Range("D21").Value = "3/4 Load"             .Range("D22").Value = "Full Load"      End With         tmHour = "-" & Hour(Time)         tmHour = tmHour & "-" & Minute(Time)         tmHour = tmHour & "-" & Second(Time)         xlApp.ActiveWorkbook.SaveAs App.Path & "\" & Format(Date, dddd, mmmm, yyyy) & tmHour + ".xls"         xlApp.Workbooks.Close         xlApp.Quit         Set xlApp = Nothing '释放引用 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''写入数据''''''''''''''''''''''''''''''''''''''''''''' Dim j, LengthTXT, k, Num, NEXCEL As Integer Dim StrTxt As String On Error Resume Next '''''''''''''''''''''''''''计算数组的围数 NUM     LengthTXT = Len(Text1.Text)     StrTxt = Text1.Text     Num = 1     For i = 1 To LengthTXT        If Mid(Text1.Text, i, 1) = "," Then           Num = Num + 1        End If     Next      ReDim StrDataArray(Num)  '重定义围数 ''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''赋值给数组 StrDataArray     If Num = 1 Then         StrDataArray(Num) = StrTxt     Else         For i = 1 To LengthTXT             StrData = StrData & Mid(StrTxt, i, 1)             k = k + 1             If Mid(StrTxt, i, 1) = "," Then                 j = j + 1                 StrDataArray(j) = Left(StrData, k - 1)                 StrData = ""                 k = 0             End If               StrDataArray(Num) = StrData         Next     End If '    '''''''''''''''''''''''''''''check StrDataArray(i) '    For i = 1 To Num '    MsgBox StrDataArray(i) & "  " & i '    Next     '''''''''''''''''''''''''''''''''''数值分段存储到数组,每组为一个实测值     Dim TowArray() As String     Dim WS, N As Integer     WS = Num \ 4 '''''''''''''''''围数     ReDim TowArray(WS, 4)      For i = 1 To Num - 2         N = i \ 4         For j = 1 To 4           'If i \ 4 = 0 Then             TowArray(N + 1, j) = StrDataArray(j + 4 * N)          ' End If         Next      Next      '    ''''''''''''''''''''''''''''''''check  TowArray(N + 1, j) '    For i = 1 To WS '      MsgBox TowArray(i, 1) & TowArray(i, 2) & TowArray(i, 3) & TowArray(i, 4) '    Next '    ''''''''''''''''''''''''''''''''''数值转换     ''''第4个字节转换为2进制

ReDim ByteDataString(WS)     For i = 1 To Num \ 4        'MsgBox TowArray(i, 4) MsgBox CStr(TowArray(i, 4))        ByteDataString(i) = HexToByte(CStr(TowArray(i, 4))) '''''转换为2进制,8位        'MsgBox ByteDataString(i) & " " & i Next     '''''''''''''''''''''''''''''''''''''''''''''''

    ''''''''''''''''打开Excel 文件！     Dim filename As String     With CommonDialog1         .DialogTitle = "打开Excel文件"

        .Filter = "(Excel)*.xls| *.xls"         .ShowOpen         filename = .filename        ' MsgBox filename     End With     '''''''''''''''''''''''''     Dim xllApp As Excel.Application     Dim xllBook As Excel.Workbook     Dim xllSheet As Excel.Worksheet     Dim xllSheet1 As Excel.Worksheet     Dim StrRow As String 'Dim i As Integer     Set xllApp = CreateObject("Excel.Application")     Set xllBook = xllApp.Workbooks.Open(filename)     Set xllSheet = xllBook.Worksheets(1) '引用第1张工作表     Set xllSheet1 = xllBook.Worksheets(2) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''将数据写入到Excel单元格中

    With xllSheet         For i = 1 To WS              NEXCEL = i              StrRow = "B" & CStr(i + 2)             ' MsgBox ByteDataString(i) '& StrRow             .Range(StrRow).Value = ValueOfData(ByteDataString(i), NEXCEL) '''''设置一个返回函数         Next     End With     Set ct = xllApp.Worksheets("Chart").ChartObjects.Add(100, 40, 300, 350) '插入图形''位置（10，40）为图形位置，（220，120）为图形的大小     ct.Chart.ChartType = xlLineStacked 'xlColumnClustered '块状图 'xl3DColumnStacked '立體直條圖'xl3DPie '图形类型为饼图     ct.Chart.SetSourceData Source:=Sheets("实测值").Range("B3:B6"), PlotBy:=xlColumns     With ct.Chart          .HasTitle = True          .ChartTitle.Characters.Font.Size = 20          .ChartTitle.Characters.Text = "折线图" '图表标题为饼图          .ChartTitle.Shadow = True ''''''标题添加边框     End With      ct.Chart.ApplyDataLabels 2, True '标志旁附图例项标志***  标志数值         xllBook.Save         xllApp.ActiveWorkbook.Save         xllApp.Application.Quit     Set xllApp = Nothing '表忘释放引用 End Sub