vb导出EXCEL设计、打印控制属性方法汇总

常熟高等专科学校 钱忆平 215500

摘 要 本文讨论了一种基于VB和EXCEL的通用数据库报表设计方案，并结合开发实例，给出了VB调用ACESS数据库实现通用数据库报表设计的程序实现方法。 关键词 数据库 报表 VB EXCEL

1. 引言

在各种数据库管理系统中，经常涉及到数据信息的分析、统计，最后将结果信息制作成报表汇总输出。在用Visual Basic设计的数据库管理系统中，报表的设计方法通常有两种。一是用VB自身的数据环境设计器（Data Environment Designer）和数据库报表设计器（Report Designer）实现；二是采用第三方的ActiveX报表控件，在此基础上直接进行设计。但是，两种报表设计方法都存在缺点。前者报表设计方法较为烦琐，在设计一些具有多项汇总的数据报表时，功能不足，报表的格式控制较为困难。后者的报表设计方法较为简便，有多种报表格式可以套用，但用户制作报表的要求和格式各不相同，难以在报表的格式和功能上真正满足用户的要求。所以，有必要寻找一种灵活方便的、能满足用户需求的、便于程序控制的报表设计方法，解决报表设计中存在的问题。利用VB和EXCEL进行通用数据库报表设计是一种有效的解决方案。

2. 通用数据库报表设计的一般方法

VB和EXCEL都是微软公司的典型产品，VB有较强的数据管理、控制和应用程序开发能力；EXCEL是一个电子表格软件，具有强大的数据处理和格式输出功能，能根据用户的要求灵活、方便地制作出各种格式的数据报表。EXCEL有自身的对象库，能够在VB中直接调用。

通过在VB中建立EXCEL的APPLICATION对象及相关子对象，用VB对数据库数据进行管理和调用，实现数据库数据从VB到EXCEL的直接输出，然后由EXCEL对数据格式化，实现通用数据库报表输出功能。通用数据库报表设计的流程框图如图1。

EXCEL的APPLICATION对象报表打印输出数据库VB的ADO调用EXCEL工作簿 图1 通用数据库报表设计流程图

3. 实现步骤

（1） 用ADO数据接口与数据库建立连接

众所周知，要实现对数据库数据的管理和调用，可以用多种不同的编程语言和不同的数据库管理系统完成，各种编程语言对数据库系统的数据调用方法也有多种，有DAO、RDO、ADO等。ADO是一种高层次的、于编程语言的、访问所有种类企业信息的数据访问接口。它基于通用对象模型（COM），简化了OLE DB的操作。OLE DB程序中使用了大量的COM接口，而ADO封装了这些接口。VB通过ADO接口可以很方便的与数据库数据通信，实现数据的管理和调用。 （2） 建立报表数据源。

数据库的报表输出实质是按用户的要求，根据报表输出内容，实现对数据库数据的条件查询。所以，需要通过ADO建立相应的记录集（RECORDSET）和命令（COMMAND）对象，结合SELECT-SQL语句，建立报表数据源。 （3） 在EXCEL 中建立报表格式样板文件

充分利用EXCEL强大的报表格式功能，按照报表样张的格式要求，在EXCEL中建立报表的样板文件，确定报表的纸张大小、页边距、报表的边框、填充、对齐方式及本课题受江苏省教育厅高校自然科学项目（02KJD0001）资助 数据格式等相关内容。这样既能灵活的满足用户对报表输出的格式要求，同时又极大的简化了报表设计的程序控制，减少了报表设计的编程工作量。 （4） 建立APPLICATION对象，实现数据填充

在VB中建立EXCEL的APPLICATION对象及相关子对象，利用VB对APPLICATION对象进行编程控制，实现数据从数据源到EXCEL单元格的数据填充。图2列出了在报表设计中EXCEL的部分主要对象模型，各对象功能如表1。 APPLICATION WORKBOOK

WORKSHEET

CELLS

RANGE

图2 EXCEL部分主要对象模型图

表1 EXCEL主要对象功能表 对象 APPLICATION WORKBOOK WORKSHEET CELLS RANGE 功能描述 处于EXCEL对象层次结构的顶层，表示EXCEL自身的运行环境 表示一个EXCEL工作簿文件 表示一个EXCEL工作表 表示一个EXCEL单元格 表示一个或多个EXCEL单元格 （5） 报表的预览和打印输出

报表的预览和打印，既可以由VB直接编程控制EXCEL在后台运行完成，也可以由用户EXCEL运行环境下参与控制，并对报表作适当修改和完善，最后完成打印输出。

4. 主要程序的实现及报表设计实例

以下结合“织机用2650电磁铁电磁参数测试系统”中的报表设计为例，用VB调用ACESS数据库，说明通用数据库报表设计的程序实现方法。

织机用2650电磁铁电磁参数管理系统是一个计算机在线测试和数据管理系统，实现对2650电磁铁的直流电压、直流电流、冷态电阻、绝缘电阻、通电磁场、剩磁等六个电磁参数及温度等非电量参数

图3 电磁参数统计报表格式图

的在线测试和数据管理。系统要求既能输出指定日期的各被测电磁铁的明细报表，也能输出指定日期的被测电磁铁的统计报表。电磁铁参数统计报表的格式如图3。测量数据存放在ACESS数据库MYDB1.MDB的PARAMETER2数据表中。

（1） 与ACESS数据库建立连接 „„

Public Sub Main()

Dim db2 as ADODB.connection Dim rs2_sql As String Dim ccc As String

Dim cnstring2 As String

Rs2_sql = \"select * from parameter2 where left(bianhao,8)=\" & Format(Date, \"yyyymmdd\") & \" order by bianhao\" ccc = App.Path

cnstring2 = cn1 + ccc + \"\\\" + \"mydb1.mdb\"

’cn1为全局变量，已定义。cn1=\"provider=microsoft.jet.oledb.4.0;’jet oledb:database password='123';data source=

Set db2 = New ADODB.Connection Db2.ConnectionString = cnstring1 Db2.Open End Sub „„

（2） 建立数据源

数据源的建立要根据报表的输出要求确定，可以用ADO的RECORDSET或COMMAND对象实现。一个统计报表通常需要根据报表的统计要求，利用SELECT-SQL语句，从数据库中有条件的选择数据建立多个数据源，才能完成对报表的数据填充。以图3中20型电磁铁各参数的平均值为例建立数据源。 „„

Dim benban_sql As String Dim riqi As String

Dim rstemp2 as adodb.recordset

riqi = CStr(Text1.Text) ‘Text1为程序界面上设计的一个文本框，接收用户输入的日期 If riqi <> \"\" Then

'统计20类型，全部质量，全部批号各参数的平均值

benban_sql = \"SELECT count(bianhao) as bianhao_cou, avg(voltage) as vol_avg, avg(current_i) as i_avg , avg(resistance_l) as r_l_avg,avg(resistance_h) as r_h_avg,avg(b_l) as b_l_avg, avg(b_h) as b_h_avg From parameter2 \"

benban_sql = benban_sql & \" where \" & \"trim(type)='20' And Left(bianhao, 8) = \" + Trim(riqi)

Set rstemp2 = New ADODB.Recordset Rstemp2.ActiveConnection = db2 Rstemp2.Source = benban_sql

Rstemp2.CursorType = adOpenStatic

Rstemp2.CursorLocation = adUseClient

Rstemp2.LockType=adLockOptimisticRstemp2.Open

„„ endif „„

（3） 建立报表格式样板文件

在EXCEL中建立报表的样板文件，工作薄文件为REPORT.XLS，工作表名为统计表。电磁铁参数统计报表的样板格式如图3。

（4） 建立EXCEL的APPLICATION及相关对象，实现数据填充 部分程序代码如下： „„

Dim xlapp As Excel.Application

Dim strsource, strdestination As String strsource = App.Path + \"\\\" + \"report.xls\"

strdestination = App.Path + \"\\\" + \"tempreport.xls\"

FileCopy strsource, strdestination ‘复制report.xls到tempreport.xls，避免直接对样板文件操作而破坏报表格式

Set xlapp = New Excel.Application

Set xlapp = CreateObject(\"excel.application\") ‘建立excel的application对象 xlapp.Visible = True ‘使excel的运行环境可见

Set xlbook = xlapp.Workbooks.Open(App.Path + \"\\\" + \"tempreport.xls\ ‘建立workbook对象，并打开tempreport.xls工作薄

Set xlsheet = xlbook.Worksheets(2) ‘建立worksheet对象，并设定tempreport.xls工作薄的第二张工作表为当前工作表

If rstemp1.Fields(\"bianhao_cou\") <> 0 Then ‘判断数据源是否有数据，然后对cells（单元格）对象进行数据填充（以20型电磁铁各参数的平均值为例进行填充）

With xlsheet

Cells(1, 1) = Trim(riqi) + \"日 电磁铁测量统计报表\" Cells(2, 5) = Trim(riqi)

Cells(5, 2) = rstemp1.Fields(\"vol_avg\") .Cells(6, 2) = rstemp1.Fields(\"i_avg\") Cells(7, 2) = rstemp1.Fields(\"r_l_avg\") Cells(8, 2) = rstemp1.Fields(\"r_h_avg\") Cells(9, 2) = rstemp1.Fields(\"b_l_avg\") Cells(10, 2) = rstemp1.Fields(\"b_h_avg\") End With End If „„ 5. 结束语

利用VB对EXCEL对象的直接编程控制，实现数据库数据到EXCEL的数据填充，找到了一种通用的数据库报表设计方法。这种报表设计方法既能灵活的满足用户对报表格式和功能的要求，大大降低了编程人员在设计报表时对报表格式和功能的编程控制难度，增强了报表设计的灵活性和通用性。上述报表设计方法和相关程序已成功应用于常熟纺织机械厂的织机用2650电磁铁电磁参数测试系统，得到的很好的控制和输出效果。

Delphi控制Excel2000

类 别:COM & ActiveX (一) 使用动态创建的方法

首先创建 Excel 对象,使用ComObj: var ExcelApp: Variant;

ExcelApp := CreateOleObject( ＇＇Excel.Application＇＇ ); 1) 显示当前窗口:

ExcelApp.Visible := True; 2) 更改 Excel 标题栏:

ExcelApp.Caption := ＇＇应用程序调用 Microsoft Excel＇＇; 3) 添加新工作簿:

ExcelApp.WorkBooks.Add; 4) 打开已存在的工作簿:

ExcelApp.WorkBooks.Open( ＇＇C:＼Excel＼Demo.xls＇＇ ); 5) 设置第2个工作表为活动工作表: ExcelApp.WorkSheets[2].Activate; 或

ExcelApp.WorksSheets[ ＇＇Sheet2＇＇ ].Activate; 6) 给单元格赋值:

ExcelApp.Cells[1,4].Value := ＇＇第一行第四列＇＇; 7) 设置指定列的宽度(单位:字符个数),以第一列为例:

ExcelApp.ActiveSheet.Columns[1].ColumnsWidth := 5; 8) 设置指定行的高度(单位:磅)(1磅＝0.035厘米),以第二行为例: ExcelApp.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米 9) 在第8行之前插入分页符:

ExcelApp.WorkSheets[1].Rows[8].PageBreak := 1; 10) 在第8列之前删除分页符:

ExcelApp.ActiveSheet.Columns[4].PageBreak := 0; 11) 指定边框线宽度:

ExcelApp.ActiveSheet.Range[ ＇＇B3:D4＇＇ ].Borders[2].Weight := 3; 1-左 2-右 3-顶 4-底 5-斜( ＼ ) 6-斜( / ) 12) 清除第一行第四列单元格公式:

ExcelApp.ActiveSheet.Cells[1,4].ClearContents; 13) 设置第一行字体属性:

ExcelApp.ActiveSheet.Rows[1].Font.Name := ＇＇隶书＇＇; ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue; ExcelApp.ActiveSheet.Rows[1].Font.Bold := True; ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True; 14) 进行页面设置: a.页眉:

ExcelApp.ActiveSheet.PageSetup.CenterHeader := ＇＇报表演示＇＇;

b.页脚:

ExcelApp.ActiveSheet.PageSetup.CenterFooter := ＇＇第&P页＇＇; c.页眉到顶端边距2cm:

ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 2/0.035; d.页脚到底端边距3cm:

ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 3/0.035; e.顶边距2cm:

ExcelApp.ActiveSheet.PageSetup.TopMargin := 2/0.035; f.底边距2cm:

ExcelApp.ActiveSheet.PageSetup.BottomMargin := 2/0.035; g.左边距2cm:

ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035; h.右边距2cm:

ExcelApp.ActiveSheet.PageSetup.RightMargin := 2/0.035; i.页面水平居中:

ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035; j.页面垂直居中:

ExcelApp.ActiveSheet.PageSetup.CenterVertically := 2/0.035; k.打印单元格网线:

ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True; 15) 拷贝操作: a.拷贝整个工作表:

ExcelApp.ActiveSheet.Used.Range.Copy; b.拷贝指定区域:

ExcelApp.ActiveSheet.Range[ ＇＇A1:E2＇＇ ].Copy; c.从A1位置开始粘贴:

ExcelApp.ActiveSheet.Range.[ ＇＇A1＇＇ ].PasteSpecial; d.从文件尾部开始粘贴:

ExcelApp.ActiveSheet.Range.PasteSpecial; 16) 插入一行或一列:

a. ExcelApp.ActiveSheet.Rows[2].Insert;

b. ExcelApp.ActiveSheet.Columns[1].Insert; 17) 删除一行或一列:

a. ExcelApp.ActiveSheet.Rows[2].Delete; b. ExcelApp.ActiveSheet.Columns[1].Delete; 18) 打印预览工作表:

ExcelApp.ActiveSheet.PrintPreview; 19) 打印输出工作表:

ExcelApp.ActiveSheet.PrintOut; 20) 工作表保存:

if not ExcelApp.ActiveWorkBook.Saved then ExcelApp.ActiveSheet.PrintPreview; 21) 工作表另存为:

ExcelApp.SaveAs( ＇＇C:＼Excel＼Demo1.xls＇＇ ); 22) 放弃存盘:

ExcelApp.ActiveWorkBook.Saved := True; 23) 关闭工作簿:

ExcelApp.WorkBooks.Close; 24) 退出 Excel: ExcelApp.Quit;

(二) 使用Delphi 控件方法

在Form中分别放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。 1) 打开Excel

ExcelApplication1.Connect; 2) 显示当前窗口:

ExcelApplication1.Visible[0]:=True; 3) 更改 Excel 标题栏:

ExcelApplication1.Caption := ＇＇应用程序调用 Microsoft Excel＇＇; 4) 添加新工作簿:

ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0)); 5) 添加新工作表:

var Temp_Worksheet: _WorkSheet; begin

Temp_Worksheet:=ExcelWorkbook1.

WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) as _WorkSheet; ExcelWorkSheet1.ConnectTo(Temp_WorkSheet); End;

6) 打开已存在的工作簿:

ExcelApplication1.Workbooks.Open (c:＼a.xls

EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) 7) 设置第2个工作表为活动工作表:

ExcelApplication1.WorkSheets[2].Activate; 或

ExcelApplication1.WorksSheets[ ＇＇Sheet2＇＇ ].Activate; 8) 给单元格赋值:

ExcelApplication1.Cells[1,4].Value := ＇＇第一行第四列＇＇; 9) 设置指定列的宽度(单位:字符个数),以第一列为例:

ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5; 10) 设置指定行的高度(单位:磅)(1磅＝0.035厘米),以第二行为例:

ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米 11) 在第8行之前插入分页符:

ExcelApplication1.WorkSheets[1].Rows[8].PageBreak := 1; 12) 在第8列之前删除分页符:

ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;

13) 指定边框线宽度:

ExcelApplication1.ActiveSheet.Range[ ＇＇B3:D4＇＇ ].Borders[2].Weight := 3; 1-左 2-右 3-顶 4-底 5-斜( ＼ ) 6-斜( / ) 14) 清除第一行第四列单元格公式:

ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents; 15) 设置第一行字体属性:

ExcelApplication1.ActiveSheet.Rows[1].Font.Name := ＇＇隶书＇＇; ExcelApplication1.ActiveSheet.Rows[1].Font.Color := clBlue; ExcelApplication1.ActiveSheet.Rows[1].Font.Bold := True; ExcelApplication1.ActiveSheet.Rows[1].Font.UnderLine := True; 16) 进行页面设置: a.页眉:

ExcelApplication1.ActiveSheet.PageSetup.CenterHeader := ＇＇报表演示＇＇; b.页脚:

ExcelApplication1.ActiveSheet.PageSetup.CenterFooter := ＇＇第&P页＇＇; c.页眉到顶端边距2cm:

ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 2/0.035; d.页脚到底端边距3cm:

ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 3/0.035; e.顶边距2cm:

ExcelApplication1.ActiveSheet.PageSetup.TopMargin := 2/0.035; f.底边距2cm:

ExcelApplication1.ActiveSheet.PageSetup.BottomMargin := 2/0.035;

g.左边距2cm:

ExcelApplication1.ActiveSheet.PageSetup.LeftMargin := 2/0.035; h.右边距2cm:

ExcelApplication1.ActiveSheet.PageSetup.RightMargin := 2/0.035; i.页面水平居中:

ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035; j.页面垂直居中:

ExcelApplication1.ActiveSheet.PageSetup.CenterVertically := 2/0.035; k.打印单元格网线:

ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True; 17) 拷贝操作: a.拷贝整个工作表:

ExcelApplication1.ActiveSheet.Used.Range.Copy; b.拷贝指定区域:

ExcelApplication1.ActiveSheet.Range[ ＇＇A1:E2＇＇ ].Copy; c.从A1位置开始粘贴:

ExcelApplication1.ActiveSheet.

6楼: http://www.delphibbs.com/delphibbs/dispq.asp？lid=3219967

看我的回答，是不是对楼主有些提示，设置单元格的格式为字符串，其实这种帖子很多的 销售管理软件版7楼: 谢谢大家了，我试一下，解决问题后马上给分。 8楼: 测试了一下，主要有以下问题

1.设置字体大小只能设置指定行，而不能用循环全部设置 例如 for i:=1 to n do

ExcelApp.ActiveSheet.Rows[n].Font.Bold := True;//出错:OLE Error 2。不能设置页眉

编译的时候不会出错，但运行时提示“不能设置类PageSetup的CenterHeader属性”

3.由于Excelapp定义为弱类型，按ctrl_space没有提示，比较麻烦，很多属性都看不到，有什么方法可以知道Excelapp具体有哪些属性？

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\单元格边框 .Range(\"A1\边框颜色

.Range(\"A1\区域 背景色

''''''''''''''''''''''''''''''

.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 = \"2\" '''''''''''''''''''''''''''''''''''负载值

.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 Integer Dim StrTxt As String On Error Resume Next

'''''''''''''''''''''''''''计算数组的围数 NUM LengthTXT = Len(Text1.Text) StrTxt = Text1.Text Num = 1

For i = 1 To LengthTXT

If Mid(Text1.Text, i, 1) = \ 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) = \ 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) & \" \" & i Next

'''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''打开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 String 'Dim 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

.ChartTitle.Characters.Font.Size = 20

.ChartTitle.Characters.Text = \"折线图\" '图表标题为饼图 .ChartTitle.Shadow = True ''''''标题添加边框 End With

ct.Chart.ApplyDataLabels 2, True '标志旁附图例项标志*** 标志数值 xllBook.Save

xllApp.ActiveWorkbook.Save xllApp.Application.Quit

Set xllApp = Nothing '表忘释放引用 End Sub

Dim xlApp As Object

Dim xlRefBook As Object '原EXCEL

Dim xlRefSheet As Object '原EXCEL SHEET Dim xlNewBook As Object '新建EXCEL

Dim xlNewSheet As Object '新建EXCEL SHEET

Set xlApp = CreateObject(\"Excel.Application\") '创建EXCEL应用类 Set xlRefBook = xlApp.Workbooks.Open(\"F:\\Visual Studio 6.0 test-code\\my_test\\my_vb_test_001\est.xls\") '打开EXCEL工作簿 Set xlRefSheet = xlRefBook.Worksheets(\"TEST\")

Set xlNewBook = xlApp.Workbooks.Add '增加一个工作薄 xlRefSheet.Copy

After:=xlNewBook.Worksheets(xlNewBook.sheets.Count) '复制原sheet至新workbook中 复制至sheet最后

Set xlNewSheet = xlNewBook.Worksheets(\"TEST\") '设置新sheet xlNewSheet.Activate '激活工作表

xlsheet.Cells(1, 1) = \"12345678\" '给单元格第1行第1列赋值 xlsheet.range(\"A7\").Value = \"777\" „给单元格A7赋值 xlNewSheet.range(xlNewSheet.Cells(1, 1), xlNewSheet.Cells(2, 2)).merge '合并 单元格

xlNewSheet.range(\"A13:Q13\").MergeCells = True '合并A13到Q13单元格

xlNewSheet.range(\"D1\").Borders.LineStyle = 1 '设置边框 range(cells(1,1),cells(1,2))

xlNewSheet.range(xlNewSheet.Cells(1, 1), xlNewSheet.Cells(2, 2)).HorizontalAlignment = 3 '单元格水平对齐 1：左 2：右 3：中 'xlnewsheet.cells(1,1).HorizontalAlignment = 3 '效果同上 xlNewSheet.range(xlNewSheet.Cells(1, 1), xlNewSheet.Cells(2, 2)).VerticalAlignment = 2 '单元格垂直对齐 1：上 2：中 3:下 'xlnewsheet.cells(1,1).VerticalAlignment = 2 '效果同上 With xlNewSheet

.Cells(3, 1) = \"AAA\"

.Cells(3, 1).Font.Bold = True '设置粗体

.Cells(3, 1).Interior.ColorIndex = 6 '设置单元格颜色 (2是白色，3是红色，4是绿色，6是黄色)

.Cells(3, 2).NumberFormatLocal = \"@\" '设置格式为文本 .Cells(3, 2) = \"2009年08月\"

.Cells(3, 2).borders.LineStyle = 1 '设置边框线条的类型 borders(i) 1:左边框 2:右边框 3:上边框 4:下边框 5:斜 6:斜 不设置:全边框

'LineStyle值：1与7－细实、2－细虚、4－点虚、9－双细实线

.Cells(3, 2).borders.Weight = 3 '设置 单元格边框宽度 .Cells(3, 2).ColumnWidth = 15 '设置 单元格宽度

'EXCEL不能设定某个单元格宽度,只能设定单元格所在列的宽度。

'选中要修改的单元格(或同一列中的其他单元格)然后用ColumnWidth设定宽度

.Cells(3, 2).EntireColumn.AutoFit '设置 整列单元格自适应宽度 xlApp.run \"宏名\参数\参数\" '运行宏

如要使 excel运行宏 需设置 安全性为中 = > 工具>宏>安全性 vb中运行宏 原（模板）book 不能关闭

使用其他excel的宏 方法为 xlApp.run \"exce文件名.xls!宏名\参数\参数\" 数据组合(数据分级显示)： Group Excel : 数据>组及分级显示>组合 vb：

行组合：

xlNewSheet.range(\"3:5\").Group => 组合 3行到5行 xlNewSheet.Rows(\"3:5\").Group => 同上 列组合：

xlNewSheet.Columns(\"A:C\").Group => 组合 A列到C列 xlNewSheet.range(.cells(,1),.cells(,3)).Group =>同上

vb 操作 数据组合的显示方式：

xlNewSheet.Outline.showLevels RowLevels/ColumnLevels:=1 数据组合边上显示的 1 一般为关闭组合(视情况而定)

xlNewSheet.Outline.showLevels RowLevels/ColumnLevels:=2 数据组合边上显示的 2 一般为打开组合(视情况而定)

xlNewSheet.Activecell.Address '取得单元格的位置(row,column) xlNewSheet.cells(1,1).Address => ($A$1)=>A1单元格 xlNewSheet.cells(1,1).row=> 1

xlNewSheet.cells(1,1).column=>1

xlNewSheet.cells(1,1).NumberFormatLocal = \"@ \" '定义单元格为 user定义（字符型）

xlNewSheet.cells(1,1).NumberFormatLocal = \"yyyymmdd\" '定义为 年月日（user定义）

xlNewSheet.cells(1,1).NumberFormatLocat = \"#,###\" '定义为 （user定义） 逗号分隔 小数位数0 输入0时 会变为空

xlNewSheet.cells(1,1).NumberFormatLocat = \"#,##0_\" '定义为 数值型 逗号分隔 小数位数0 (录制宏 实验可得出其他) 输入0是 不会为空 End With

xlapp.Visible = True '设置EXCEL对象可见（或不可见）

xlNewBook .SaveAs (\"D:\\123.xls\")

xlRefBook .Close (True) '关闭EXCEL工作簿 xlApp.Quit '关闭EXCEL