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

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 IntegerDim StrTxt As StringOn 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) & & iNext 打开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 StringDim 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 .ChartTitl