VB创建Excel表格合并单元格生成图形等操作.docx
- 文档编号:3501544
- 上传时间:2023-05-05
- 格式:DOCX
- 页数:9
- 大小:16.47KB
VB创建Excel表格合并单元格生成图形等操作.docx
《VB创建Excel表格合并单元格生成图形等操作.docx》由会员分享,可在线阅读,更多相关《VB创建Excel表格合并单元格生成图形等操作.docx(9页珍藏版)》请在冰点文库上搜索。
VB创建Excel表格合并单元格生成图形等操作
PrivateSubCommand4_Click()
OnErrorResumeNext
''''''''''''''''''''''''''''''''''''''''''''''''''''''''CreateExcelTable''''''''''''''''''''''''''''''''''''''''''
DimxlAppAsExcel.Application
DimxlBookAsExcel.Workbook
DimxlSheetAsExcel.Worksheet
DimxlSheet1AsExcel.Worksheet
DimiAsInteger,tmHourAsString
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
OnErrorResumeNext
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SetxlApp=Excel.Application
SetxlBook=xlApp.Workbooks.Add
'xlBook.Activate
SetxlSheet=xlBook.Worksheets
(1)'''''''''''''''''''''''''''''''''引用第1张工作表xlApp.ActiveSheet.Rows.VerticalAlignment=xlVAlignCenter'''''垂直方向居中
xlApp.ActiveSheet.Rows.HorizontalAlignment=xlVAlignCenter'''水平方向居中
xlSheet.Name="实测值"
SetxlSheet1=xlBook.Worksheets
(2)
xlSheet1.Name="Chart"
WithxlSheet
Fori=2To11
.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
''''''''''''''''''''''''''设置行高'设置列宽
Fori=1To22
.Rows(i).RowHeight=25
Next
Fori=1To11
.Columns(i).ColumnWidth=15
Next
'''''''''''''''''''''''''''合并单元格
Fori=3To22
Ifi<8Then
单元格
单元格
框
色.Range(Cells(3,1),Cells(i,1)).Merge'''''''''''合并A3-A7.Range(Cells(3,8),Cells(i,8)).Merge'''''''''''合并H3-H7ElseIfi<13Then
.Range(Cells(8,1),Cells(i,1)).Merge
.Range(Cells(8,8),Cells(i,8)).Merge
ElseIfi<18Then
.Range(Cells(13,1),Cells(i,1)).Merge
.Range(Cells(13,8),Cells(i,8)).Merge
ElseIfi<23Then
.Range(Cells(18,1),Cells(i,1)).Merge
.Range(Cells(18,8),Cells(i,8)).Merge
EndIf
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/4Load"
.Range("D5").Value="2/4Load"
.Range("D6").Value="3/4Load"
.Range("D7").Value="FullLoad"
.Range("D8").Value="0"
.Range("D9").Value="1/4Load"
.Range("D10").Value="2/4Load"
.Range("D11").Value="3/4Load"
.Range("D12").Value="FullLoad"
.Range("D13").Value="0"
.Range("D14").Value="1/4Load"
.Range("D15").Value="2/4Load"
.Range("D16").Value="3/4Load"
.Range("D17").Value="FullLoad"
.Range("D18").Value="0"
.Range("D19").Value="1/4Load"
.Range("D20").Value="2/4Load"
.Range("D21").Value="3/4Load"
.Range("D22").Value="FullLoad"
EndWith
tmHour="-"&Hour(Time)
tmHour=tmHour&"-"&Minute(Time)
tmHour=tmHour&"-"&Second(Time)
xlApp.ActiveWorkbook.SaveAsApp.Path&"\"&Format(Date,dddd,mmmm,yyyy)&tmHour+".xls"
xlApp.Workbooks.Close
xlApp.Quit
SetxlApp=Nothing'释放引用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''写入数据'''''''''''''''''''''''''''''''''''''''''''''
Dimj,LengthTXT,k,Num,NEXCELAsInteger
DimStrTxtAsString
OnErrorResumeNext
'''''''''''''''''''''''''''计算数组的围数NUM
LengthTXT=Len(Text1.Text)
StrTxt=Text1.Text
Num=1
Fori=1ToLengthTXT
IfMid(Text1.Text,i,1)=","Then
Num=Num+1
EndIf
Next
ReDimStrDataArray(Num)'重定义围数
'''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''赋值给数组StrDataArray
IfNum=1Then
StrDataArray(Num)=StrTxt
Else
Fori=1ToLengthTXT
StrData=StrData&Mid(StrTxt,i,1)
k=k+1
IfMid(StrTxt,i,1)=","Then
j=j+1
StrDataArray(j)=Left(StrData,k-1)
StrData=""
k=0
EndIf
StrDataArray(Num)=StrData
Next
EndIf
''''''''''''''''''''''''''''''checkStrDataArray(i)
'Fori=1ToNum
'MsgBoxStrDataArray(i)&""&i
'Next
'''''''''''''''''''''''''''''''''''数值分段存储到数组,每组为一个实测值
DimTowArray()AsString
DimWS,NAsInteger
WS=Num\4'''''''''''''''''围数
ReDimTowArray(WS,4)
Fori=1ToNum-2
N=i\4
Forj=1To4
'Ifi\4=0Then
TowArray(N+1,j)=StrDataArray(j+4*N)
'EndIf
Next
Next
'''''''''''''''''''''''''''''''''checkTowArray(N+1,j)
'Fori=1ToWS
'MsgBoxTowArray(i,1)&TowArray(i,2)&TowArray(i,3)&TowArray(i,4)
'Next
'''''''''''''''''''''''''''''''''''数值转换
''''第4个字节转换为2进制
ReDimByteDataString(WS)
Fori=1ToNum\4
'MsgBoxTowArray(i,4)MsgBoxCStr(TowArray(i,4))
ByteDataString(i)=HexToByte(CStr(TowArray(i,4)))'''''转换为2进制,8位'MsgBoxByteDataString(i)&""&i
Next
'''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''打开Excel文件!
DimfilenameAsString
WithCommonDialog1
.DialogTitle="打开Excel文件"
.Filter="(Excel)*.xls|*.xls"
.ShowOpen
filename=.filename
'MsgBoxfilename
EndWith
'''''''''''''''''''''''''
DimxllAppAsExcel.Application
DimxllBookAsExcel.Workbook
DimxllSheetAsExcel.Worksheet
DimxllSheet1AsExcel.Worksheet
DimStrRowAsString
'DimiAsInteger
SetxllApp=CreateObject("Excel.Application")
SetxllBook=xllApp.Workbooks.Open(filename)
SetxllSheet=xllBook.Worksheets
(1)'引用第1张工作表
SetxllSheet1=xllBook.Worksheets
(2)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''将数据写入到Excel单元格中
WithxllSheet
Fori=1ToWS
NEXCEL=i
StrRow="B"&CStr(i+2)
'MsgBoxByteDataString(i)'&StrRow
.Range(StrRow).Value=ValueOfData(ByteDataString(i),NEXCEL)'''''设置一个返回函数
Next
EndWith
Setct=xllApp.Worksheets("Chart").ChartObjects.Add(100,40,300,350)'插入图形''位置(10,40)为图形位置,(220,120)为图形的大小
ct.Chart.ChartType=xlLineStacked'xlColumnClustered
测值'块状图'xl3DColumnStacked'立體直條圖'xl3DPie'图形类型为饼图
ct.Chart.SetSourceData
PlotBy:
=xlColumns
Withct.Chart
.HasTitle=True
.ChartTitle.Characters.Font.Size=20
.ChartTitle.Characters.Text="折线图"'图表标题为饼图
.ChartTitle.Shadow=True''''''标题添加边框
EndWith
ct.Chart.ApplyDataLabels2,True'标志旁附图例项标志***标志数值xllBook.Save
xllApp.ActiveWorkbook.Save
xllApp.Application.Quit
SetxllApp=Nothing'表忘释放引用
EndSubSource:
=Sheets("实").Range("B3:
B6"),
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 创建 Excel 表格 合并 单元格 生成 图形 操作