1、Private Sub Command4_Click()On Error Resume NextCreate Excel TableDim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetDim xlSheet1 As Excel.WorksheetDim i As Integer, tmHour As StringOn Error Resume NextSet xlApp = Excel.ApplicationSet xlBook = xlApp.Workbooks.Add
2、xlBook.ActivateSet 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 xlSheetFor i = 2 To 11.Rang
3、e(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 = 25NextFor i = 1 To 11.Columns(i).ColumnWidth = 15Next合并单元格For i = 3 To 22If i 8 Then.Range(Cells(3, 1), Cells(i, 1).Merge 合并 A3-A7单元格.Rang
4、e(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).MergeElseIf i 18 Then.Range(Cells(13, 1), Cells(i, 1).Merge.Range(Cells(13, 8), Cells(i, 8).MergeElseIf i 23 Then.Range(Cells(18, 1), Cells(i, 1).Merge.Range(Cells(18, 8),
5、 Cells(i, 8).MergeEnd IfNext.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 = “楷书“ 设置字体字型.R
6、ange(“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 = “初级到次级功
7、率损耗(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“.Ran
8、ge(“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
9、“.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 WithtmHour = “-“ & Hour(Time)tmHour = tmHour & “-“ & Minute(Time)tmHour = tmHour & “-“ & Second(Time)xlApp.A
10、ctiveWorkbook.SaveAs App.Path & “ & Format(Date, dddd, mmmm, yyyy) & tmHour + “.xls“xlApp.Workbooks.ClosexlApp.QuitSet xlApp = Nothing 释放引用写入数据Dim j, LengthTXT, k, Num, NEXCEL As IntegerDim StrTxt As StringOn Error Resume Next计算数组的围数 NUMLengthTXT = Len(Text1.Text)StrTxt = Text1.TextNum = 1For i = 1
11、To LengthTXTIf Mid(Text1.Text, i, 1) = “,“ ThenNum = Num + 1End IfNextReDim StrDataArray(Num) 重定义围数赋值给数组 StrDataArrayIf Num = 1 ThenStrDataArray(Num) = StrTxtElseFor i = 1 To LengthTXTStrData = StrData & Mid(StrTxt, i, 1)k = k + 1If Mid(StrTxt, i, 1) = “,“ Thenj = j + 1StrDataArray(j) = Left(StrData
12、, k - 1)StrData = “k = 0End IfStrDataArray(Num) = StrDataNextEnd If check StrDataArray(i) For i = 1 To Num MsgBox StrDataArray(i) & “ “ & i Next数值分段存储到数组 ,每组为一个实测值Dim TowArray() As StringDim WS, N As IntegerWS = Num 4 围数ReDim TowArray(WS, 4)For i = 1 To Num - 2N = i 4For j = 1 To 4If i 4 = 0 ThenTow
13、Array(N + 1, j) = StrDataArray(j + 4 * N) End IfNextNext 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 4MsgBox TowArray(i, 4) MsgBox CStr(TowArray(i, 4)ByteDataString(
14、i) = HexToByte(CStr(TowArray(i, 4) 转换为 2 进制,8位MsgBox ByteDataString(i) & “ “ & iNext打开 Excel 文件！Dim filename As StringWith CommonDialog1.DialogTitle = “打开 Excel 文件“.Filter = “(Excel)*.xls| *.xls“.ShowOpenfilename = .filename MsgBox filenameEnd WithDim xllApp As Excel.ApplicationDim xllBook As Excel.
15、WorkbookDim xllSheet As Excel.WorksheetDim xllSheet1 As Excel.WorksheetDim StrRow As StringDim i As IntegerSet xllApp = CreateObject(“Excel.Application“)Set xllBook = xllApp.Workbooks.Open(filename)Set xllSheet = xllBook.Worksheets(1) 引用第 1 张工作表Set xllSheet1 = xllBook.Worksheets(2)将数据写入到 Excel 单元格中W
16、ith xllSheetFor i = 1 To WSNEXCEL = iStrRow = “B“ & CStr(i + 2) MsgBox ByteDataString(i) & StrRow.Range(StrRow).Value = ValueOfData(ByteDataString(i), NEXCEL) 设置一个返回函数NextEnd WithSet ct = xllApp.Worksheets(“Chart“).ChartObjects.Add(100, 40, 300, 350) 插入图形位置（10，40）为图形位置， （220，120）为图形的大小ct.Chart.Chart
17、Type = xlLineStacked xlColumnClustered 块状图 xl3DColumnStacked 立體直條圖xl3DPie 图形类型为饼图ct.Chart.SetSourceData Source:=Sheets(“实测值“).Range(“B3:B6“), PlotBy:=xlColumnsWith ct.Chart.HasTitle = True.ChartTitle.Characters.Font.Size = 20.ChartTitle.Characters.Text = “折线图“ 图表标题为饼图.ChartTitle.Shadow = True 标题添加边框End Withct.Chart.ApplyDataLabels 2, True 标志旁附图例项标志* 标志数值xllBook.SavexllApp.ActiveWorkbook.SavexllApp.Application.QuitSet xllApp = Nothing 表忘释放引用End Sub
