VB创建Excel表格合并单元格生成图形等操作.docx

1、VB创建Excel表格合并单元格生成图形等操作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 xlBoo

2、k = xlApp.Workbooks.AddxlBook.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 = ChartWith xlSheetFor i =

3、 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 = 25NextFor i = 1 To 11.Columns(i).ColumnWidth = 15Next合并单元格For i = 3 To 22If i 8 Then单元格单元格框色.Range(Cells(3, 1), Cells(i, 1).Mer

4、ge 合并A3-A7.Range(Cells(3, 8), Cells(i, 8).Merge 合并H3-H7ElseIf 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(Ce

5、lls(18, 8), 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 = 楷书 设置字体字型.Range(A1).Font.Size =

6、 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标准电

7、压值.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.R

8、ange(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

9、(D22).Value = Full LoadEnd WithtmHour = - & Hour(Time)tmHour = tmHour & - & Minute(Time)tmHour = tmHour & - & Second(Time)xlApp.ActiveWorkbook.SaveAsApp.Path&Format(Date,dddd,mmmm, yyyy) & tmHour + .xlsxlApp.Workbooks.ClosexlApp.QuitSet xlApp = Nothing 释放引用写入数据Dim j, LengthTXT, k, Num, NEXCEL As Int

10、egerDim StrTxt As StringOn Error Resume Next计算数组的围数NUMLengthTXT = Len(Text1.Text)StrTxt = Text1.TextNum = 1For i = 1 To LengthTXTIf Mid(Text1.Text, i, 1) = , ThenNum = Num + 1End IfNextReDim StrDataArray(Num)重定义围数赋值给数组StrDataArrayIf Num = 1 ThenStrDataArray(Num) = StrTxtElseFor i = 1 To LengthTXTStr

11、Data = StrData & Mid(StrTxt, i, 1)k = k + 1If Mid(StrTxt, i, 1) = , Thenj = j + 1StrDataArray(j) = Left(StrData, k - 1)StrData = k = 0End IfStrDataArray(Num) = StrDataNextEnd Ifcheck StrDataArray(i)For i = 1 To NumMsgBox StrDataArray(i) & & iNext数值分段存储到数组,每组为一个实测值Dim TowArray() As StringDim WS, N As

12、 IntegerWS = Num 4 围数ReDim TowArray(WS, 4)For i = 1 To Num - 2N = i 4For j = 1 To 4If i 4 = 0 ThenTowArray(N + 1, j) = StrDataArray(j + 4 * N) End IfNextNextcheckTowArray(N + 1, j)For i = 1 To WSMsgBoxTowArray(i, 1) &TowArray(i, 2) & TowArray(i, 3) & TowArray(i,4)Next数值转换第4个字节转换为2进制ReDim ByteDataStr

13、ing(WS)For i = 1 To Num 4MsgBox TowArray(i, 4) MsgBox CStr(TowArray(i, 4)ByteDataString(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 M

14、sgBox filenameEnd WithDim xllApp As Excel.ApplicationDim xllBook As Excel.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.Workshe

15、ets(1) 引用第1张工作表Set xllSheet1 = xllBook.Worksheets(2)将数据写入到Excel单元格中With 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,

16、 300, 350) 插入图形位置（10，40）为图形位置，（220，120）为图形的大小ct.Chart.ChartType=xlLineStackedxlColumnClustered测值块状图xl3DColumnStacked 立體直條圖xl3DPie 图形类型为饼图ct.Chart.SetSourceDataPlotBy:=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 SubSource:=Sheets(实).Range(B3:B6),