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

1、 .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 = 15合并单元格For i = 3 To 22If i 8 Then单元格框色.Range（Cells（3, 1）, Cells（i, 1）.Merge 合并A3-A7.Range（Cells（3, 8）, Cells（i, 8）.Merge 合并H3-H7ElseIf i 1

2、3 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）.Merge 23 Then.Range（Cells（18, 1）, Cells（i, 1）.Merge.Range（Cells（18, 8）, Cells（i, 8）.MergeEnd If.Range（A1,K22）.Borders.LineStyle=xlCon

3、tinuous单元格边.Range（, ）.Borders.Color = vbBlue 边框颜色.Range（）.Interior.Color = RGB（100, 180, 0） 区域背景）.Value = iWatt项目）.Font.Color = vbRed 设置字体颜色）.Font.Name = 楷书 设置字体字型）.Font.Size = 30 设置字体字号A2输入电压（VAC）B2输入功率（W）C2输出电压（V）D2输出电流mA）E2输出功率（W）F2纹波电压（A）G2效率（%）H2过流点（A）I2初级到次级功率损耗（W）J2平均功率%K2需符合CEC标准电压值A390A8115

4、A13230A18264负载值D30D41/4 LoadD52/4 LoadD63/4 LoadD7Full LoadD8D9D10D11D12D13D14D15D16D17D18D19D20D21D22End WithtmHour = - & Hour（Time）tmHour = tmHour & Minute（Time） Second（Time）xlApp.ActiveWorkbook.SaveAsApp.Path&Format（Date,dddd,mmmm, yyyy） & tmHour + .xlsxlApp.Workbooks.ClosexlApp.QuitSet xlApp = N

5、othing 释放引用写入数据Dim j, LengthTXT, k, Num, NEXCEL As IntegerDim StrTxt As String计算数组的围数NUMLengthTXT = Len（Text1.Text）StrTxt = Text1.TextNum = 1For i = 1 To LengthTXTIf Mid（Text1.Text, i, 1） = ThenNum = Num + 1ReDim StrDataArray（Num）重定义围数赋值给数组StrDataArrayIf Num = 1 ThenStrDataArray（Num） = StrTxtElseStr

6、Data = StrData & Mid（StrTxt, i, 1）k = k + 1If Mid（StrTxt, i, 1） = j = j + 1StrDataArray（j） = Left（StrData, k - 1）StrData = k = 0StrDataArray（Num） = StrDatacheck StrDataArray（i）For i = 1 To NumMsgBox StrDataArray（i） & i数值分段存储到数组,每组为一个实测值Dim TowArray（） As StringDim WS, N As IntegerWS = Num 4 围数ReDim T

7、owArray（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 IfcheckTowArray（N + 1, j）For i = 1 To WSMsgBoxTowArray（i, 1） &TowArray（i, 2） & TowArray（i, 3） & TowArray（i,4）数值转换第4个字节转换为2进制ReDim ByteDataString（WS）For i = 1 To Num 4MsgBox TowArray

8、（i, 4） MsgBox CStr（TowArray（i, 4）ByteDataString（i） = HexToByte（CStr（TowArray（i, 4） 转换为2进制,8位MsgBox ByteDataString（i） &打开Excel文件！Dim filename As StringWith CommonDialog1.DialogTitle = 打开Excel文件.Filter = （Excel）*.xls| *.xls.ShowOpenfilename = .filename MsgBox filenameDim xllApp As Excel.ApplicationDim

9、 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.Worksheets（1） 引用第1张工作表Set xllSheet1 = xllBook.Worksheets（2）将数据写

10、入到Excel单元格中With xllSheetNEXCEL = iStrRow = B CStr（i + 2） MsgBox ByteDataString（i） StrRow.Range（StrRow）.Value=ValueOfData（ByteDataString（i）,NEXCEL）设置一个返回函数Set ct = xllApp.Worksheets（）.ChartObjects.Add（100, 40, 300, 350） 插入图形位置（10，40）为图形位置，（220，120）为图形的大小ct.Chart.ChartType=xlLineStackedxlColumnCluster

11、ed测值块状图xl3DColumnStacked 立體直條圖xl3DPie 图形类型为饼图ct.Chart.SetSourceDataPlotBy:=xlColumnsWith ct.Chart.HasTitle = True.ChartTitle.Characters.Font.Size = 20.ChartTitle.Characters.Text = 折线图图表标题为饼图.ChartTitle.Shadow = True 标题添加边框ct.Chart.ApplyDataLabels 2, True 标志旁附图例项标志*标志数值xllBook.SavexllApp.ActiveWorkbook.SavexllApp.Application.QuitSet xllApp = Nothing 表忘释放引用End SubSource:=Sheets（实）.Range（B3:B6）,