VB中使用EXCEL输出
- 格式:doc
- 大小:58.50 KB
- 文档页数:12
VB对excel操作的方法总汇教程用VB操作excel方法汇总Private Sub Command1_Click()Dim i As LongDim j As LongDim objExl As Excel.Application '声明对象变量Me.MousePointer = 11 '改变鼠标样式Set objExl = New Excel.Application '初始化对象变量objExl.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1 objExl.Workbooks.Add '增加一个工作薄objExl.Sheets(objExl.Sheets.Count).Name = "book1" '修改工作薄名称objExl.Sheets.Add , objExl.Sheets("book1") '增加第二个工作薄在第一个之后objExl.Sheets(objExl.Sheets.Count).Name = "book2"objExl.Sheets.Add , objExl.Sheets("book2") '增加第三个工作薄在第二个之后objExl.Sheets(objExl.Sheets.Count).Name = "book3"objExl.Sheets("book1").Select '选中工作薄<book1>For i = 1 To 50 '循环写入数据For j = 1 To 5If i = 1 ThenobjExl.Selection.NumberFormatLocal = "@" '设置格式为文本objExl.Cells(i, j) = " E " & i & jElseobjExl.Cells(i, j) = i & jEnd IfNextNextobjExl.Rows("1:1").Select '选中第一行objExl.Selection.Font.Bold = True '设为粗体objExl.Selection.Font.Size = 24 '设置字体大小objExl.Cells.EntireColumn.AutoFit '自动调整列宽objExl.ActiveWindow.SplitRow = 1 '拆分第一行objExl.ActiveWindow.SplitColumn = 0 '拆分列objExl.ActiveWindow.FreezePanes = True '固定拆分objExl.ActiveSheet.PageSetup.PrintTitleRows = "$11" '设置打印固定行objExl.ActiveSheet.PageSetup.PrintTitleColumns = "" '打印标题objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & _ Format(Now, "yyyy年mm月dd日 hh:MM:ss")objExl.ActiveWindow.View = xlPageBreakPreview '设置显示方式objExl.ActiveWindow.Zoom = 100 '设置显示大小'给工作表加密码objExl.ActiveSheet.Protect "123", DrawingObjects:=True, _Contents:=True, Scenarios:=TrueobjExl.Application.IgnoreRemoteRequests = FalseobjExl.Visible = True '使EXCEL可见objExl.Application.WindowState = xlMaximized 'EXCEL的显示方式为最大化objExl.ActiveWindow.WindowState = xlMaximized '工作薄显示方式为最大化objExl.SheetsInNewWorkbook = 3 '将默认新工作薄数量改回3个Set objExl = Nothing '清除对象Me.MousePointer = 0 '修改鼠标Exit SubEnd Sub全面控制 Excel首先创建 Excel 对象,使用ComObj:Dim ExcelID as Excel.ApplicationSet ExcelID as new Excel.Application1) 显示当前窗口:ExcelID.Visible :=True;2) 更改Excel 标题栏:ExcelID.Caption := '应用程序调用 MicrosoftExcel';3) 添加新工作簿:ExcelID.WorkBooks.Add;4) 打开已存在的工作簿:ExcelID.WorkBooks.Open( 'C:\Excel\Demo.xls' );5) 设置第2个工作表为活动工作表:ExcelID.WorkSheets[2].Activate;或ExcelID.WorkSheets[ 'Sheet2' ].Activate;6) 给单元格赋值:ExcelID.Cells[1,4].Value := '第一行第四列';7) 设置指定列的宽度(单位:字符个数),以第一列为例:ExcelID.ActiveSheet.Columns[1].Colu mnsWidth := 5;8) 设置指定行的高度(单位:磅)(1磅=0.035厘米),以第二行为例:ExcelID.ActiveSheet.Rows[2].RowHeig ht := 1/0.035; // 1厘米9) 在第8行之前插入分页符:ExcelID.WorkSheets[1].Rows[8].PageB reak := 1;10) 在第8列之前删除分页符:ExcelID.ActiveSheet.Columns[4].Page Break := 0;11) 指定边框线宽度:ExcelID.ActiveSheet.Range[ 'B34' ].Bor ders[2].Weight := 3;1-左 2-右 3-顶 4-底 5-斜( \ ) 6-斜( / )12) 清除第一行第四列单元格公式:ExcelID.ActiveSheet.Cells[1,4].ClearConten ts;13) 设置第一行字体属性:ExcelID.ActiveSheet.Rows[1].Font.Na me := '隶书';ExcelID.ActiveSheet.Rows[1].Font.Colo r := clBlue;ExcelID.ActiveSheet.Rows[1].Font.Bold := True;ExcelID.ActiveSheet.Rows[1].Font.Und erLine := True;14) 进行页面设置:a.页眉:ExcelID.ActiveSheet.PageSetup.CenterHea der := '报表演示';b.页脚:ExcelID.ActiveSheet.PageSetup.CenterFoo ter := '第&页';c.页眉到顶端边距2cm:ExcelID.ActiveSheet.PageSetup.HeaderMa rgin := 2/0.035;d.页脚到底端边距3cm:ExcelID.ActiveSheet.PageSetup.HeaderMa rgin := 3/0.035;e.顶边距2cm:ExcelID.ActiveSheet.PageSetup.T opMargin := 2/0.035;f.底边距2cm:ExcelID.ActiveSheet.PageSetup.BottomMa rgin := 2/0.035;g.左边距2cm:ExcelID.ActiveSheet.PageSetup.LeftMargin := 2/0.035;h.右边距2cm:ExcelID.ActiveSheet.PageSetup.RightMarg in := 2/0.035;i.页面水平居中:ExcelID.ActiveSheet.PageSetup.CenterHori zontally := 2/0.035;j.页面垂直居中:ExcelID.ActiveSheet.PageSetup.CenterVert ically := 2/0.035;k.打印单元格网线:ExcelID.ActiveSheet.PageSetup.PrintGridLi nes := True;15) 拷贝操作:a.拷贝整个工作表:ed.Range.Copy;b.拷贝指定区域:ExcelID.ActiveSheet.Range[ 'A1:E2' ].Copy;c.从A1位置开始粘贴:ExcelID.ActiveSheet.Range.[ 'A1' ].PasteSp ecial;d.从文件尾部开始粘贴:ExcelID.ActiveSheet.Range.PasteSpecial;16) 插入一行或一列:a. ExcelID.ActiveSheet.Rows[2].Insert;b.ExcelID.ActiveSheet.Columns[1].Insert;17) 删除一行或一列:a. ExcelID.ActiveSheet.Rows[2].Delete;b.ExcelID.ActiveSheet.Columns[1].Delete;18) 打印预览工作表:ExcelID.ActiveSheet.PrintPreview;19) 打印输出工作表:ExcelID.ActiveSheet.PrintOut;20) 工作表保存:If not ExcelID.ActiveWorkBook.Saved thenExcelID.ActiveSheet.PrintPreviewEnd if21) 工作表另存为:ExcelID.SaveAs( 'C:\Excel\Demo1.xls' );22) 放弃存盘:ExcelID.ActiveWorkBook.Saved := True;23) 关闭工作簿:ExcelID.WorkBooks.Close;24) 退出 Excel:ExcelID.Quit;25) 设置工作表密码:ExcelID.ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True26) EXCEL的显示方式为最大化ExcelID.Application.WindowState = xlMaximized27) 工作薄显示方式为最大化ExcelID.ActiveWindow.WindowState = xlMaximized28) 设置打开默认工作薄数量ExcelID.SheetsInNewWorkbook = 329) '关闭时是否提示保存(true 保存;false 不保存)ExcelID.DisplayAlerts = False30) 设置拆分窗口,及固定行位置ExcelID.ActiveWindow.SplitRow = 1ExcelID.ActiveWindow.FreezePanes = True31) 设置打印时固定打印内容ExcelID.ActiveSheet.PageSetup.PrintTi tleRows = "$11"32) 设置打印标题ExcelID.ActiveSheet.PageSetup.PrintTi tleColumns = ""33) 设置显示方式(分页方式显示)ExcelID.ActiveWindow.View = xlPageBreakPreview34) 设置显示比例ExcelID.ActiveWindow.Zoom = 100。
VB操作EXCEL,实现数据写入以及数据组合1】定义EXCEL的一系列操作Dim xlApp As Excel.ApplicationDim ExcelShowStr As StringSet xlApp = CreateObject("Excel.Application")xlApp.Visible = trueAppLog (CStr(Date) & "_" & CStr(Time) & ":Set xlApp=new Excel.Application") Dim xlBook As WorkbookDim xlSheet As WorksheetDim xlrow, sheetIndex, sheetColumn As Integer' ="D:\VB英迈\Template\WriteData.xls" Editable=空值Set xlBook = xlApp.Workbooks.Open(, Editable) '打开EXCEL模板Set xlSheet = xlApp.ActiveSheet--------------------------------------------------------------------------------------------【2】写入数据的操作xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1, 1)).Merge '合并单元格xlSheet.Cells(beginRow, 1).FormulaR1C1 = CustName '单行插入xlSheet.Cells(beginRow, 1).VerticalAlignment = xlTop '垂直,写入数据的位置,这里为高xlSheet.Cells(beginRow, 2).HorizontalAlignment = xlHAlignCenter '水平写入数据的位置,这里为居中xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1, 19)).Font.ColorIndex = ConstModule.COLOR_BLUE '单元格的字体颜色xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1, 19)).Font.Bold = True '单元格的数据为粗体显示xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1,19)).Interior.ColorIndex = ConstModule.COLOR_SILVER '单元格的背景颜色定义数组,一次性写入,列子如下:If DetailRes.RecordCount > 0 ThenDetailRes.MoveFirstFor row2 = 0 To DetailRes.RecordCount - 1Dim arrayProduct(50, 17) As StringarrayProduct(row2, 0) = DetailRes.Fields("Product")arrayProduct(row2, 1) = DetailRes.Fields("rev")arrayProduct(row2, 2) = DetailRes.Fields("sagm")arrayProduct(row2, 3) = DetailRes.Fields("sagm_per") & "%"arrayProduct(row2, 4) = DetailRes.Fields("gp")arrayProduct(row2, 5) = DetailRes.Fields("gp_per") & "%"arrayProduct(row2, 6) = DetailRes.Fields("opex")arrayProduct(row2, 7) = DetailRes.Fields("opex_per") & "%"arrayProduct(row2, 8) = DetailRes.Fields("oper_profit")arrayProduct(row2, 9) = DetailRes.Fields("oper_profit_per") & "%"arrayProduct(row2, 10) = DetailRes.Fields("dio")arrayProduct(row2, 11) = DetailRes.Fields("dpo")arrayProduct(row2, 12) = DetailRes.Fields("dso")arrayProduct(row2, 13) = DetailRes.Fields("working_capital")arrayProduct(row2, 14) = DetailRes.Fields("interests")arrayProduct(row2, 15) = DetailRes.Fields("pre_tax_income")arrayProduct(row2, 16) = DetailRes.Fields("roic") & "%"DetailRes.MoveNextNext row2xlSheet.Range(xlSheet.Cells(beginRow, 3), xlSheet.Cells(endRow - 1, 19)) = arrayProduct() '数组显示--------------------------------------------------------------------------------------------【3-重点】vb操作EXCEL实现数据组合现在需要把单元格1-4行进行数据组合在EXCEL中,只要选中单元格1-4行,在点击菜单> > 数据> > 组及分级显示> > 组合即可达到要求![注]:若组合时,收缩时数据显示的是最后的那条,在EXCEL文件中,点击数据>> 组及分级显示>> 设置>>(1)把明细数据的下方复选框的选中状态改为不选中(2)把明细数据的右侧复选框的选中状态改为不选中这样设置数据即可达到显示要求vb代码如下:Rows("10:15").SelectSelection.Rows.Group若是需要变量传入,则:Rows(beginRow & ":" & endRow - 1).SelectSelection.Rows.GroupVB操作EXCEL,实现数据读取基于VB和EXCEL的报表设计及打印在现代管理信息系统的开发中,经常涉及到数据信息的分析、加工,最终还需把统计结果形成各种形式的报表提供给领导决策参考,或进行外部交流。
VB导出Excel(导入指定格式的Excel文档中)VB 是常用的应用软件开发工具之一,由于VB的报表功能有限,而且一旦报表的格式发生变化,就得相应修改程序,给应用软件的维护工作带来极大的不便。
因此有很多程序员现在已经充分利用Excel 的强大报表功能来实现报表功能。
但由于 VB 与 Excel 分别属于不同的应用系统,如何把它们有机地结合在一起,是一个值得我们研究的课题。
1、在工程中添加一些报表的引用:如下:Interop.Excel(选择 Microsoft Excel 9.0 Object Library ---Excel 2000)然后选择确定,表示在工程中已经添加了类库。
2、在通用对象的声明过程中定义 Excel 对象dim xlApp As Excel.Application ‘Application 对象是 Excel 对象模型中最高层级的对象,代表Excel应用程序本身,也包含组成工作薄的许多部分,包括工作薄、工作表、单元格集合以及它们包含的数据。
dim xlBook As Excel.Workbook ’设置 xlBook 为一个工作薄dim xlSheet As Excel.Worksheet ‘设置 xlSheet 为一个工作薄的工作表3、在程序中操作 Excel 表常用命令:xlApp.AskToUpdateLinks=False‘来取消讨厌的对话框xlApp.Application.AskToUpdateLinks=False’屏蔽是否更新链接的对话框x lApp.AlertBeforeOverwriting=False’屏蔽弹出保存和覆盖的询问提示框xlApp.Application.DisplayAlerts=False‘屏蔽删除工作表时询问是否删除的对话框xlApp.Visible=False'设置 Excel 对象不可见(或可见)xlBook=xlApp.Workbooks.Open(fileName,2,False)’打开已经存在的 Excel 工作薄文件xlBook.Save()'保存xlBook.Close(True)'关闭工作薄x lApp.Quit()’结束 Excel 对象xlApp=Nothing ‘释放 xlApp 对象xlBook=Nothing ’释放 xlBook 对象xlSheet=Nothing ‘释放 xlSheet 对象4、在运用以上 VB 命令操作 Excel 表时,除非设置 Excel 对象不可见,否则 VB 程序可继续执行其他操作,也能够关闭 Excel,同时也可对 Excel 进行操作。
VB中操作Excel(创建EXCEL的OLE对象,前提,主机已安装EXCEL)一、Excel对象模型为了在VB应用程序中调用Excel,必须要了解Excel对象模型。
Excel对象模型描述了Excel的理论结构,所提供的对象很多,其中最重要的对象,即涉及VB调用Excel最可能用到的对象有:二、调用Excel在VB应用程序中调用Excel,实质是将Excel作为一个外部对象来引用,由Excel对象模型提供能从VB应用程序内部来程序化操纵的对象以及相关的属性、方法和事件。
1、在VB工程中添加对Excel类型库的引用为了能从VB应用程序中访问Excel丰富的内部资源,使Excel应用程序运行得更快,需要在VB工程中添加对Excel类型库的引用。
具体步骤如下:a)从VB5“工程”菜单中选择“引用”;b)在“引用”对话框中选择Excel类型库:"Microsoft Excel9.0 Object Library";c)单击左边小方框,使之出现“√”符号;d)按“确定”退出。
注:要想在VB应用程序中调用Excel,你的计算机系统中必须安装Excel。
2、引用Application对象Application对象是Excel对象模型的顶层,表示整个Excel应用程序。
在VB应用程序中调用Excel,就是使用Application对象的属性、方法和事件。
为此,首先要声明对象变量:或直接声明为Excel对象:在声明对象变量之后,可用CreateObject函数或GetObject函数给变量赋值新的或已存在的Application对象引用。
a)用CreateObject函数生成新的对象引用:字符串“Excel.Application”是提供Excel应用程序的编程ID,这个变量引用Excel应用程序本身。
b)用GetO场ect函数打开已存在的对象引用:上面语句打开文件SAMP.XLS。
3、Application对象常用的属性、方法示例1:求值数学表达式:三、使用Excel应用程序如前所述,在VB应用程序中调用Excel应用程序,就是使用Application对象的属性、方法和事件。
VB打开EXCEL的方法在Visual Basic中,可以使用多种方法打开Excel文件。
以下是其中一些常用的方法。
1. 使用Excel对象库:使用Excel对象库可以直接在VB中打开Excel文件,并获取其内容。
首先,需要在VB项目中引用Excel对象库。
打开VB项目,在树状视图中选择"项目",然后选择"引用"。
在"可用组件"中找到"Microsoft Excel x.x Object Library"(其中 x.x 是Excel的版本号),勾选并点击"确定"。
接下来,可以使用以下代码打开Excel文件:```vbImports Excel = Microsoft.Office.Interop.ExcelDim xlApp As Excel.ApplicationDim xlWorkbook As Excel.WorkbookDim xlWorksheet As Excel.Worksheet' 创建Excel应用程序对象xlApp = New Excel.ApplicationxlApp.Visible = True' 打开Excel文件xlWorkbook =xlApp.Workbooks.Open("C:\path\to\your\excel\file.xlsx") xlWorksheet = xlWorkbook.Worksheets(1) ' 打开第一个工作表```通过以上代码,将打开Excel文件并将第一个工作表赋值给xlWorksheet 变量。
2. 使用OleDb连接:除了使用Excel对象库,还可以使用OleDb连接字符串来打开Excel 文件。
这种方法不需要引用Excel对象库,并且适用于各种版本的Excel 文件。
```vbImports System.Data.OleDbDim connectionString As String ="Provider=Microsoft.ACE.OLEDB.12.0;DataSource=C:\path\to\your\excel\file.xlsx;Extended Properties=Excel 12.0"Dim connection As OleDbConnection = NewOleDbConnection(connectionString)Dim adapter As OleDbDataAdapterDim dataSet As DataSet'打开连接connection.Open' 读取Excel数据dataSet = New DataSetadapter.Fill(dataSet)' 将数据加载到DataGridView控件DataGridView1.DataSource = dataSet.Tables(0)'关闭连接connection.Close```以上代码使用OleDb连接字符串连接到Excel文件,并将数据加载到DataSet中。
用vb语言输出excel并设置纸张为A4Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetSet xlApp = CreateObject("Excel.Application") '创建EXCEL对象Set xlBook = xlApp.Workbooks.Add '打开已经存在的EXCEL工件簿文件xlApp.Visible = True '设置EXCEL对象可见(或不可见)Set xlSheet = xlBook.Worksheets(1) '设置活动工作表xlSheet.Cells(1, 1) = "我的手机135********" '给单元格(row,col)赋值xlSheet.PageSetup.PaperSize = xlPaperA4xlSheet.PageSetup.FirstPageNumber = xlAutomaticxlSheet.PageSetup.BlackAndWhite = FalsexlSheet.PageSetup.Zoom = 100为了搞清楚这个问题。
我又试验着录制宏,发现,只要我在录制宏的时候选定了某些打印的纸张格式,那么在papersize 的选项中出现了127这个数字。
在papersize这个选项中,不同的纸张格式都有一个代表他的数值。
例如:可选的默认名称代表数值尺寸xlPaper10x14 16 10 英寸 x 14 英寸xlPaperA4 9 A4(210 毫米 x 297 毫米)那么问题就变的很简单,解决的方法如下:第一:在XP 打印机和传真机文件夹中,右击,选着打印机服务器,添加自定义格式的。
第二:通过录制宏,获得纸张 papersize对应的数字。
VBA实现Excel数据导入和导出的实用方法Excel是一款功能强大的办公软件,而VBA(Visual Basic for Applications)是Excel的一种编程语言,它可以帮助我们实现各种自动化任务。
在本篇文章中,我将为您介绍VBA实现Excel数据导入和导出的实用方法。
一、数据导入方法:1. 打开Excel,按下“ALT + F11”打开VBA编辑器。
2. 在VBA编辑器中,选择“插入”-“模块”,在新建的模块中编写以下代码:```vbaSub ImportData()Dim dataWorkbook As WorkbookDim importWorkbook As WorkbookDim importSheet As WorksheetDim importRange As Range'选择需要导入数据的Excel文件Application.FileDialog(msoFileDialogOpen).Show'将选择的文件导入到新建的工作簿Set importWorkbook =Workbooks.Open(FileName:=Application.FileDialog(msoFileDialogOpen). SelectedItems(1))'选择需要导入数据的工作表和范围Set importSheet = importWorkbook.Sheets("Sheet1") '根据需要修改工作表名称Set importRange = importSheet.Range("A1:B10") '根据需要修改数据范围'将数据复制到当前工作簿中importRange.Copy ThisWorkbook.Sheets("Sheet1").Range("A1") '根据需要修改当前工作簿和工作表名称'关闭导入的工作簿,不保存更改importWorkbook.Close SaveChanges:=FalseEnd Sub```3. 关闭VBA编辑器,返回Excel界面,按下“ALT + F8”调出宏对话框,选择并运行“ImportData”宏。
Vb对excel操作的实例第一篇:Vb对excel操作的实例Vb对excel操作的实例最近,由于工作关系,我用vb6.0做了一个计算成绩的软件,由于我不会数据库技术,同行对excel应用又比较普遍,所以就用vb6.0操作excel完成了成绩统计的任务。
先说说窗体,很简单,只运用了菜单,由此来调用程序代码。
截图如下:窗体命名为excel操作,共五个一级菜单。
创建表册用来制作所用表格。
计算成绩用来算成绩。
模拟运算用来测试软件,设置了两个子菜单,一个填随机生成的数据。
有了数据就可以计算成绩了,看看效果如何。
测试完了就可以清空数据了,清空成绩册中的基础数据以后再计算一次成绩就基本可以使表册恢复原样了。
其实,我这是多此一举,回头一想,只需要重新创建所用表册就行了。
还画蛇添足了俩菜单:计算器和退出。
代码也贴出来共享一下。
创建表册:一年级: Private Sub ynjkb_Click()Call 建空表(10)Call 工作表命名(1)Call 成绩册(1)Unload excel操作 End Sub 创建表册:二年级:Private Sub enjkb_Click()Call 建空表(10)Call 工作表命名(2)Call 成绩册(2)Unload excel操作 End Sub 三至六年级略了吧。
创建表册:学校总评:Private Sub xxzp_Click()nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)= “五年级”: nj(6)= “六年级” Call 建空表(2)'建立积分表Sheets(1).Name = “学校积分” Sheets(2).Name = “积分” Sheets(“学校积分”).Select Range(“a1:i1”).Merge [a1] = “学校积分统计表”: [a2] = “学校”: [a3] = “南村小学”: [a4] = “东风小学”: [a5] = “兴中小学”: [a6] = “尧场小学” nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)=“五年级”: nj(6)= “六年级” For i = 1 To 6 Cells(2, i + 1)= nj(i)+ “积分” Next Cells(2, 8)= “均积分”: Cells(2, 9)= “名次” Range([a1], [i6]).Select Selection.HorizontalAlignment = xlCenter Call 表格加线(Range([a2], [i6]))Call 横排(6, 9)ActiveSheet.PageSetup.Orientation = xlLandscape Unload excel操作 End Sub 创建表册:上报:Private Sub shangbao_Click()Call 建空表(2)Sheets(1).Name = “中心校” Sheets(“中心校”).Select Call 上报表(“中心校”)Sheets(2).Name = “普小” Sheets(“普小”).Select Call 上报表(“普小”)Unload excel操作 End Sub 计算成绩:一年级: Private Sub yinianji_Click()Call 打开工作表 Call 算成绩(1)kmb(1)= “语文”: kmb(2)= “数学”: kmb(3)= “英语” Sheets(kmb(1)).Select For i = 1 To 8'记录一年级语文数据With bj(i).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(1).njxh = 1 End With Next Sheets(kmb(2)).Select For i = 1 To 8'记录一年级数学数据 With bj(i + 8).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(2).njxh = 1 End With Next Dim hgrs(8)'记录各学校合格人数For i = 1 To 8 Sheets(xx(i)).Select szl = Application.WorksheetFunction.Match(“总分”, Range([a2], [f2]))'总分所在列即合格人数所在列szh = Application.WorksheetFunction.Match(“合格人数”, Range(Cells(2, szl), Cells(80, szl)))'“合格人数”所在行hgrs(i)= Cells(szh + 2, szl)Next '向学校总评表过录一年级数据nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)= “五年级”: nj(6)= “六年级” Workbooks.OpenFileName:=ActiveWorkbook.Path & “学校总评.xls” For i = 1 To 16 Wit h Sheets(“积分”)Sheets(“积分”).Select [a1] = “年级”: [a2] = “学科”: [a3] = “学校”: [a4] = “人数”: [a5] = “总分”: [a6] = “及格人数”: [a7] = “优秀人数”: [a8] = “积分”.Cells(1, i + 1)= nj(bj(i).njxh).Cells(2, i + 1)= bj(i).bjkm.Cells(3, i + 1)= bj(i).xxmc.Cells(4, i + 1)= bj(i).xkrs.Cells(5, i + 1)= bj(i).xkzf.Cells(6, i + 1)= bj(i).xkjgr.Cells(7, i + 1)= bj(i).xkyxr.Cells(8, i + 1)= bj(i).xkjf End With Next Workbooks.Open FileName:=ActiveWorkbook.Path & “上报.xls” With Sheets(“中心校”)'过录中心校成绩.Cells(bj(1).njxh * 2 + 2, 3)= bj(1).xkrs + bj(2).xkrs + bj(6).xkrs '语文.Cells(bj(1).njxh * 2 + 2, 4)= bj(1).xkzf + bj(2).xkzf + bj(6).xkzf.Cells(bj(1).njxh * 2 + 2, 5)= Round(.Cells(bj(1).njxh * 2 + 2, 4)/.Cells(bj(1).njxh * 2 + 2, 3), 2).Cells(bj(1).njxh * 2 + 2, 6)= bj(1).xkjgr + bj(2).xkjgr + bj(6).xkjgr.Cells(bj(1).njxh * 2 + 2, 7)= bj(1).xkyxr + bj(2).xkyxr + bj(6).xkyxr.Cells(bj(1).njxh * 2 + 2, 8)= hgrs(1)+ hgrs(2)+ hgrs(6).Cells(bj(1).njxh * 2 + 3, 3)= bj(9).xkrs + bj(10).xkrs + bj(14).xkrs '数学.Cells(bj(1).njxh * 2 + 3, 4)= bj(9).xkzf + bj(10).xkzf + bj(14).xkzf.Cells(bj(1).njxh * 2 + 3, 5)= Round(.Cells(bj(1).njxh * 2 + 3, 4)/.Cells(bj(1).njxh * 2 + 3, 3), 2).Cells(bj(1).njxh * 2 + 3, 6)= bj(9).xkjgr + bj(10).xkjgr + bj(14).xkjgr.Cells(bj(1).njxh * 2 + 3, 7)= bj(9).xkyxr + bj(10).xkyxr + bj(14).xkyxr.Cells(bj(1).njxh * 2 + 3, 8)= hgrs(1)+ hgrs(2)+ hgrs(6)End With With Sheets(“普小”)'过录普小成绩.Cells(bj(1).njxh * 2 + 2, 3)= bj(3).xkrs + bj(4).xkrs + bj(5).xkrs + bj(7).xkrs + bj(8).xkrs '语文.Cells(bj(1).njxh * 2 + 2, 4)= bj(3).xkzf + bj(4).xkzf + bj(5).xkzf + bj(7).xkzf + bj(8).xkzf.Cells(bj(1).njxh * 2 + 2, 5)= Round(.Cells(bj(1).njxh * 2 + 2, 4)/.Cells(bj(1).njxh * 2 + 2, 3),2).Cells(bj(1).njxh * 2 + 2, 6)= bj(3).xkjgr + bj(4).xkjgr + bj(5).xkjgr + bj(7).xkjgr + bj(8).xkjgr.Cells(bj(1).njxh * 2 + 2, 7)= bj(3).xkyxr + bj(4).xkyxr + bj(5).xkyxr + bj(7).xkyxr + bj(8).xkyxr.Cells(bj(1).njxh * 2 + 2, 8)= hgrs(3)+ hgrs(4)+ hgrs(5)+ hgrs(7)+ hgrs(8).Cells(bj(1).njxh * 2 + 3, 3)= bj(11).xkrs + bj(12).xkrs + bj(13).xkrs + bj(15).xkrs + bj(16).xkrs '数学.Cells(bj(1).njxh * 2 + 3, 4)= bj(11).xkzf + bj(12).xkzf + bj(13).xkzf + bj(15).xkzf + bj(16).xkzf.Cells(bj(1).njxh * 2 + 3, 5)= Round(.Cells(bj(1).njxh * 2 + 3, 4)/.Cells(bj(1).njxh * 2 + 3, 3), 2).Cells(bj(1).njxh * 2 + 3, 6)= bj(11).xkjgr + bj(12).xkjgr + bj(13).xkjgr + bj(15).xkjgr + bj(15).xkjgr.Cells(bj(1).njxh * 2 + 3, 7)= bj(11).xkyxr + bj(12).xkyxr + bj(13).xkyxr + bj(15).xkyxr + bj(16).xkyxr.Cells(bj(1).njxh * 2 + 3, 8)= hgrs(3)+ hgrs(4)+ hgrs(5)+ hgrs(7)+ hgrs(8)End With Unload excel操作 End Sub 计算成绩:二年级略。
Private Sub cmdSwatch_Click()Dim xls As excel.ApplicationDim xlbook As excel.Workbook'On Error GoTo exlErrorDim i As IntegerIf Dir(Text1.Text) <> "" Then '此目录下如有同名文件给出提示,并作相应处理If MsgBox("文件已存在,是否覆盖!", vbYesNo + vbQuestion, "另存为工程造价文件") = vbNo Then Exit SubElseKill (Text1.Text) '删除文件End IfEnd If'************打开工作表***************Set xls = New excel.Applicationxls.Visible = TrueSet xlbook = xls.Workbooks.Add'*********************************For i = 0 To 14If Check2(i).Value = vbChecked ThenSelect Case iCase 8ToExcelJDanJiaSum.ToExcelJDanJiaSum xlbook, xlsCase 9ToExcelADanJiaSum.ToExcelADanJiaSum xlbook, xlsCase 10ToExcelCailiao.ToExcelCailiao xlbook, xlsCase 11ToExcelTsf.ToExcelTsf xlbook, xlsCase 12ToExcelZgcl.ToExcelZgcl xlbook, xlsEnd SelectEnd IfNextFor i = 0 To 6If Check3(i).Value = vbChecked ThenSelect Case iCase 0ToExcelMan.ToExcelMan xlbook, xlsCase 1ToExcelFSD_CL.ToExcelFSD_CL xlbook, xls Case 2ToExcelHNT.ToExcelHNT xlbook, xlsCase 3ToExcelZsf.ToExcelZsf xlbook, xlsCase 4ToExcelJingChang.ToExcelJingChang xlbook, xls Case 5ToExcelJDanJia.ToExcelJDanJia xlbook, xls Case 6ToExcelADanJia.ToExcelADanJia xlbook, xls End SelectEnd IfNextxlbook.SaveAs Text1.Text '保存EXCEL文件'***************************关闭EXCEL对象*******************If Check1.Value = vbChecked Thenxlbook.Closexls.QuitEnd IfSet xlbook = NothingSet xls = NothingExit Sub'exlError:' MsgBox Err.Description, vbOKOnly + vbCritical, "警告"End SubOption ExplicitPublic Sub ToExcelZgcl(ByRef xlbook, ByRef xls) '输出总工程量Dim con As New ADODB.ConnectionDim rst_gcl As New ADODB.RecordsetDim rst_qm As New ADODB.Recordset'**************************连接数据库****************************************con.CursorLocation = adUseClientcon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"con.Openrst_gcl.Open "zonggcl", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开工程量汇总表If Not (rst_gcl.BOF And rst_gcl.EOF) Thenrst_gcl.MoveFirstEnd Ifrst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开签名表rst_qm.MoveFirst'****************************工作表初使化*********************************** Dim xlsheet As excel.WorksheetSet xlsheet = xlbook.Sheets.Add '添加一张工作表 = "工程量汇总"xls.ActiveSheet.PageSetup.Orientation = xlLandscape '纸张设置为横向xlsheet.Columns("a:j").Font.Size = 10xlsheet.Columns("a:j").VerticalAlignment = xlVAlignCenter '垂直居中xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐xlsheet.Columns(1).ColumnWidth = 8xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeftxlsheet.Columns(2).ColumnWidth = 26xlsheet.Columns("c:j").HorizontalAlignment = xlHAlignRightxlsheet.Columns("c:j").ColumnWidth = 10xlsheet.Columns("c:j").NumberFormatLocal = "0.00_ " '3到10列保留两位小数'***************************写入标头************************************* xlsheet.Rows(1).RowHeight = 40xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 10)).MergeCells = Truexlsheet.Cells(1, 1).Value = "工程量汇总"xlsheet.Cells(1, 1).Font.Size = 14xlsheet.Cells(1, 1).Font.Bold = Truexlsheet.Rows(2).RowHeight = 18xlsheet.Rows(2).HorizontalAlignment = xlHAlignCenterxlsheet.Cells(2, 1).Value = "序号"xlsheet.Cells(2, 2).Value = "工程项目及名称"xlsheet.Cells(2, 3).Value = "土方开挖(m3)"xlsheet.Cells(2, 4).Value = "石方开挖(m3)"xlsheet.Cells(2, 5).Value = "土方回填(m3)"xlsheet.Cells(2, 6).Value = "洞挖石方(m3)"xlsheet.Cells(2, 7).Value = "砼浇筑(m3)"xlsheet.Cells(2, 8).Value = "钢筋制安(t)"xlsheet.Cells(2, 9).Value = "砌石工程(m3)"xlsheet.Cells(2, 10).Value = "灌浆工程(m)"xls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$2" '固定表头'***************************写入内容*************************Dim i As Integeri = 3 'i控制行Dim j As Integer 'j控制列Dim countpage As Integercountpage = 0 '控制页Do While Not rst_gcl.EOFxlsheet.Rows(i).RowHeight = 18 '控制行高For j = 1 To 10xlsheet.Cells(i, j) = rst_gcl.Fields(j) '将工程理库中的一条记录的第一个字段写入工作表中Next'每18行为一页,如果数据超出一页时进行特殊处理If i > 18 Thenxls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行End IfIf i Mod 18 = 0 ThenIf countpage = 0 Thenxlsheet.Range(xlsheet.Cells(2, 1), xlsheet.Cells(i, 10)).Borders.LineStyle = xlContinuous '首页加边框Elsexlsheet.Range(xlsheet.Cells(23 + (countpage - 1) * 18, 1), xlsheet.Cells(i, 10)).Borders.LineStyle = xlContinuous '中间页加边框End Ifi = i + 2 '加一条空行'******************************在非尾页写入签名**************************************xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(64) & rst_qm.Fields(0)xlsheet.Rows(i).RowHeight = 30i = i + 1 '换行xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(50) & rst_qm.Fields(1)xlsheet.Rows(i).RowHeight = 15i = i + 1xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(55) & rst_qm.Fields(2)xlsheet.Rows(i).RowHeight = 30'****************************************************************************xlsheet.HPageBreaks.Add (xlsheet.Rows(i + 1)) '添加分页符countpage = countpage + 1 '换页End Ifi = i + 1rst_gcl.MoveNextLoopxlsheet.Range(xlsheet.Cells(23 + (countpage - 1) * 18, 1), xlsheet.Cells(i - 1, 10)).Borders.LineStyle = xlContinuous '尾页加边框i = i + 1 '加入一空行'*********************************在尾页加签名*************************************** xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(64) & rst_qm.Fields(0)xlsheet.Rows(i).RowHeight = 30i = i + 1 '换行xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(50) & rst_qm.Fields(1)xlsheet.Rows(i).RowHeight = 15i = i + 1xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(55) & rst_qm.Fields(2)xlsheet.Rows(i).RowHeight = 30'*********************************************************************************** xls.ActiveWindow.View = xlPageBreakPreview '分页预览xls.ActiveWindow.Zoom = 100If con.State = adStateOpen Thenrst_gcl.Closerst_qm.CloseSet rst_gcl = NothingSet rst_qm = Nothingcon.CloseSet con = NothingEnd IfSet xlsheet = NothingEnd SubOption ExplicitPublic Sub ToExcelTsf(ByRef xlbook, ByRef xls)Dim con As New ADODB.ConnectionDim rst_tsf As New ADODB.RecordsetDim rst_qm As New ADODB.Recordset'**********************************连接数据库************************con.CursorLocation = adUseClientcon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"con.Openrst_tsf.Open "tdefeiyong", con, adOpenKeyset, adLockOptimistic, adCmdTableIf Not (rst_tsf.BOF And rst_tsf.EOF) Thenrst_tsf.MoveFirstEnd Ifrst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTablerst_qm.MoveFirst'*********************************工作表初使化**********************************Dim xlsheet As excel.WorksheetSet xlsheet = xlbook.Sheets.Add = "机械台时、组时费汇总表"xlsheet.Columns(1).ColumnWidth = 5xlsheet.Columns(2).ColumnWidth = 20xlsheet.Columns(3).ColumnWidth = 7xlsheet.Columns(4).ColumnWidth = 7xlsheet.Columns(5).ColumnWidth = 7xlsheet.Columns(6).ColumnWidth = 7xlsheet.Columns(7).ColumnWidth = 7xlsheet.Columns(8).ColumnWidth = 7xlsheet.Columns(9).ColumnWidth = 7xlsheet.Columns("A:I").Font.Size = 9xlsheet.Columns("A:I").VerticalAlignment = xlVAlignCenter '垂直居中xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeft '2列水平左对齐'******************************写入标头************************************ xlsheet.Rows(1).RowHeight = 35xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 9)).MergeCells = Truexlsheet.Cells(1, 1).Font.Size = 14xlsheet.Cells(1, 1).Font.Bold = Truexlsheet.Cells(1, 1).Value = "机械台时、组时费汇总表"xlsheet.Cells(2, 9).Value = "单位:元"xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(5, 1)).MergeCells = Truexlsheet.Cells(3, 1).Value = "编号"xlsheet.Range(xlsheet.Cells(3, 2), xlsheet.Cells(5, 2)).MergeCells = Truexlsheet.Cells(3, 2).Value = "机械名称"xlsheet.Range(xlsheet.Cells(3, 3), xlsheet.Cells(5, 3)).MergeCells = Truexlsheet.Cells(3, 3).Value = "台时费"xlsheet.Range(xlsheet.Cells(3, 4), xlsheet.Cells(3, 9)).MergeCells = Truexlsheet.Cells(3, 4).Value = "其中"xlsheet.Range(xlsheet.Cells(3, 3), xlsheet.Cells(5, 3)).MergeCells = Truexlsheet.Cells(3, 3).Value = "台时费"xlsheet.Range(xlsheet.Cells(4, 4), xlsheet.Cells(5, 4)).MergeCells = Truexlsheet.Cells(4, 4).Value = "折旧费"xlsheet.Range(xlsheet.Cells(4, 5), xlsheet.Cells(5, 5)).MergeCells = Truexlsheet.Cells(4, 5).Value = "修理替换费"xlsheet.Range(xlsheet.Cells(4, 6), xlsheet.Cells(5, 6)).MergeCells = Truexlsheet.Cells(4, 6).Value = "安拆费"xlsheet.Range(xlsheet.Cells(4, 7), xlsheet.Cells(5, 7)).MergeCells = Truexlsheet.Cells(4, 7).Value = "人工费"xlsheet.Range(xlsheet.Cells(4, 8), xlsheet.Cells(5, 8)).MergeCells = Truexlsheet.Cells(4, 8).Value = "燃料费"xlsheet.Range(xlsheet.Cells(4, 9), xlsheet.Cells(5, 9)).MergeCells = Truexlsheet.Cells(4, 9).Value = "其他费"xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(5, 9)).HorizontalAlignment = xlHAlignCenterxls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$5" '固定表头'****************************************写入内容************************************* Dim i As Integeri = 6Do While Not rst_tsf.EOFxlsheet.Cells(i, 1).Value = rst_tsf.Fields("nn")xlsheet.Cells(i, 2).Value = rst_tsf.Fields("name")xlsheet.Cells(i, 3).Value = rst_tsf.Fields("price")xlsheet.Cells(i, 4).Value = rst_tsf.Fields("zhejiu")xlsheet.Cells(i, 5).Value = rst_tsf.Fields("xiuli")xlsheet.Cells(i, 6).Value = rst_tsf.Fields("anchai")xlsheet.Cells(i, 7).Value = rst_tsf.Fields("rengong")xlsheet.Cells(i, 8).Value = rst_tsf.Fields("dongli")xlsheet.Cells(i, 9).Value = rst_tsf.Fields("qita")If i > 22 Thenxls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行End Ifi = i + 1rst_tsf.MoveNextLoopxlsheet.Range(xlsheet.Cells(6, 3), xlsheet.Cells(i - 1, 9)).NumberFormatLocal = "0.00_ " '保留两位小数'*********************************添加边框********************************** xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(i - 1, 9)).Borders.LineStyle = xlContinuous '****************************************************************************** xls.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(2.2) '设置下侧面边距xls.ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(1) '设置页脚高xls.ActiveSheet.PageSetup.CenterFooter = "&10" & rst_qm.Fields(0) & Chr(10) & Chr(10) &rst_qm.Fields(1) & Chr(10) & Chr(10) & rst_qm.Fields(2) '加页脚xls.ActiveWindow.View = xlPageBreakPreview '分页预览xls.ActiveWindow.Zoom = 100'***************************关闭记录集******************* If con.State = adStateOpen Thenrst_tsf.Closerst_qm.CloseSet rst_tsf = NothingSet rst_qm = Nothingcon.CloseSet con = NothingEnd IfSet xlsheet = NothingEnd Sub精彩的后续作者Blog:/mi6236/。
在VB中要想调用Excel,需要打开VB编程环境“工程”菜单中的“引用”项目,并选取项目中的“Microsoft Excel 11.0 object library”项。
由于你的Excel 版本不同,所以这个选项的版本号也是不同的。
因为EXCEL是以层次结构组织对象的,其对象模型中含有许多不同的对象元素。
第一层:Application对象,即Excel本身;第二层:workbooks对象集,指Excel的工作簿文件;第三层:worksheets对象集,表示的是Excel的一个工作表;第四层:Cells和Range对象,指向Excel工作表中的单元格。
新建立一个VB的工程,先放一个button,名称为Excel_Out。
先定义好各层:Dim xlapp As Excel.Application 'Excel对象Dim xlbook As Excel.Workbook '工作簿Dim xlsheet As Excel.Worksheet '工作表我们打算做的是:打开/新建一个excel,在其中对某工作表的一些单元格修改其值,然后另存为test.xls文件。
Private Sub Excel_Out_Click()Dim i, j As IntegerSet xlapp = CreateObject("Excel.Application") '创建EXCEL对象'Set xlbook = xlapp.Workbooks.Open(App.Path & "\test.xls") '打开已经存在的test.xls工件簿文件Set xlbook = xlapp.Workbooks.Add '新建EXCEL工件簿文件'xlbook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏'xlbook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏xlapp.Visible = True '设置EXCEL对象可见(或不可见)Set xlsheet = xlbook.Worksheets(1) '设置活动工作表''''~~~当前工作簿的第一页,这里也可以换成“表名”'下面就是简单的在一些单元格内写入数字For i = 7 To 15For j = 1 To 10xlsheet.Cells(i, j) = j '当前工作簿第一页的第I行第J列Next jNext iWith xlsheet '设置边框为是实线.Range(.Cells(7, 1), .Cells(28, 29)).Borders.LineStyle =xlContinuousEnd With'引用当前工作簿的第二页Set xlsheet = xlapp.Application.Worksheets(2)xlsheet.Cells(7, 2) = 2008 '在第二页的第7行第2列写入2008 xlsheet.SaveAs App.Path & "\test.xls" '按指定文件名存盘'Set xlbook = xlapp.Application.Workbooks.Add '新建一空白工作簿xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.CloseSet xlapp = Nothing '释放xlApp对象End Sub这样,我们就可以简单的对excel文件进行操作了。
VBA实现Excel的数据读写与导出Excel是一款功能强大的电子表格软件,可以进行各种数据处理和分析。
VBA(Visual Basic for Applications)是一种编程语言,可以在Excel中进行自动化操作和定制功能。
通过使用VBA,我们可以实现Excel的数据读写和导出功能,提高工作效率和数据处理能力。
首先,我们需要了解如何使用VBA进行数据读取。
通过VBA,我们可以从Excel表格中读取数据并进行操作。
以下是实现这一功能的步骤:1. 启动Excel并打开目标工作簿。
2. 按下"Alt + F11"打开VBA编辑器。
3. 在VBA编辑器中,选择左侧的"插入",然后选择"模块"。
4. 在新建的模块中编写VBA代码。
例如,我们可以使用以下代码将A1单元格的值读取到一个变量中:```Dim value As Variantvalue = Sheets("Sheet1").Range("A1").Value```在这个示例中,我们使用`Sheets("Sheet1").Range("A1").Value`读取A1单元格的值并将其存储在`value`变量中。
5. 可以使用条件语句、循环和其他VBA命令对读取的数据进行进一步的处理和操作。
接下来,我们将学习如何使用VBA进行数据导出。
通过VBA,我们可以将Excel中的数据导出为不同格式的文件,例如CSV(逗号分隔值)或TXT(文本文件)。
以下是实现这一功能的步骤:1. 打开Excel并选择要导出的工作簿或工作表。
2. 按下"Alt + F11"打开VBA编辑器。
3. 在VBA编辑器中,选择左侧的"插入",然后选择"模块"。
4. 在新建的模块中编写VBA代码。
如何在VB中实现输出到Excelvisual basic 2009-12-04 12:38:22 阅读61 评论0字号:大中小订阅首先要在工程中添加引用“Microsoft Excel 9.0 Object Library”我们使用三个对象Excel.ApplicationExcel.WorkBookExcel.WorkSheet然后我们的目标是:能新建一个Excel文件。
讲某些行列进行合并,设置列宽,填入一个数据,将这个Excel 保存。
Public Sub'定义对象Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet1 As Excel.WorksheetDim xlSheet2 As Excel.WorksheetSet xlApp = CreateObject("Excel.Application")Set xlBook = xlApp.Workbooks.AddSet xlSheet1 = xlBook.Worksheets("sheet1")Set xlSheet2 = xlBook.Worksheets("sheet2")'参数是下标!!!一定是按照Sheet1,Sheet2,Sheet3这样的顺序来的。
= "值班表" '修改工作簿的名称,就是将显示的名称换掉 = "呼拉拉" '同上xlSheet1.PageSetup.Orientation = xlLandscape '打印设置-- 设置为横向xlSheet1.PageSetup.TopMargin = 20 '一下四部分为设置Excel的显示格式xlSheet1.PageSetup.BottomMargin = 20xlSheet1.PageSetup.LeftMargin = 8xlSheet1.PageSetup.RightMargin = 8xlApp.Visible = True 'Excel文件是不是显示With xlSheet1.Columns.item(1).ColumnWidth() = 2 '列宽大小.Range(.Cells(1, 1), .Cells(3, 1)).Merge '合并.Cells(1, 1).Value = "123" '填入数据End WithxlApp.Visible = False '这样写,Excel的操作就不显示了。
Visual Basic调用Excel之技巧吴声松(湖北省水利水电勘测设计院地质大队湖北430070)Visual Basic(以下简称VB)是一套可视化、面向对象、事件驱动方式的结构化程序设计语言,已经成为许多程序设计者甚至专业程序员用来开发WINDOWS应用程序的首选开发工具。
但用过VB的程序设计人员都知道,要想用VB输出复杂的表格来,是十分困难的。
能不能用VB 调用EXCEL呢?Active技术标准为我们解决了这个问题。
最近笔者为单位开发“土工试验数据整理”的某个模块时,涉及到复杂数据表格的输出问题,经过笔者的摸索,用VB调用EXCEL,取得了很好的效果。
本文从编程实践的角度对使用VB控制EXCEL的技术作简要说明。
1 EXCEL的对象模型如果一个应用程序支持自动化技术,那么其它的应用就可以通过其暴露的对象,对它进行控制,控制程序称为客户机,而被控制的一方就称为服务器,被控制的对象就是Active对象。
VB正是通过EXCEL显露的各级对象来控制EXCEL工作的。
每个对象都有各自的方法和属性,通过方法可以实现对对象的控制,而属性则可以改变对象的各种状态。
理解EXCEL的对象模型是对其编程的基础。
EXCEL是以层次结构组织对象的,其对象模型中含有许多不同的对象元素,这些对象元素就是VB可以操纵的。
在EXCEL对象的层次结构中,最顶层是Application 对象,是Excel本身。
从该对象开始往下依次是:.workbooks对象集,是Application对象的下层,其指的是Excel的工作簿文件。
.worksheets对象集,是Workbooks对象集的下层,它表示的是Excel的一个工作表。
.Cells和Range对象,它们是worksheets对象的下层,它则指向Excel工作表中的一个或多个单元格。
以上介绍的四个对象是Excel中最重要也是用得最多的对象,而且从上面的介绍中也不难看出,要控制Excel中的某个具体对象,如某个工作簿中某一表格中的单元格,就必须从Excel层次结构对象的最上层即Application对象开始遍历。
OWC使用方法OWC==> Office Web Components是微软Office的轻量级开发工具,随Office安装时一起安装Office2003版本对应OWC11,里面有5个控件对象图表工作区对象数据源控件对象记录集控件对象数据透视表列表对象电子表格对象很久以前用过的,最近有人问就翻出来看看其实很简单,只是可能没有到注意文档罢了我简单用VB做了下常用的SpreadSheet例子Form上加一个Spreadsheet控件代码,很简单,没什么好说的Private Sub Form_Load()'单元格'可以使用循环的方式填充单元格Spreadsheet1.Cells(1, 1) = "第1个格"Spreadsheet1.Cells(1, 5) = "第5个格"'区域'合并Spreadsheet1.Range("A3:D3").MergeSpreadsheet1.Range("A3:D3").Value = "合并效果"'格式设置Spreadsheet1.Range("A3:D3") = "黑体"Spreadsheet1.Range("A3:D3").Font.Size = 15Spreadsheet1.Range("A3:D3").Borders(xlEdgeTop).Color = vbRedSpreadsheet1.Range("A3:D3").Borders(xlEdgeBottom).Color = vbRedSpreadsheet1.Range("A3:D3").Borders(xlEdgeLeft).Color = vbRedSpreadsheet1.Range("A3:D3").Borders(xlEdgeRight).Color = vbRed'' '不提示直接保存为本地文件'' Spreadsheet1.Export "c:\xxx.xls", ssExportActionNone'' '直接在Excel中打开'' Spreadsheet1.Export "c:\xxx.xls", ssExportActionOpenInExcelEnd Sub运行出来就是这个样子因为整个编程中使用了VBA语法,所以还是很容易理解的如果你的机器上安装了Office2000/xp/2003那么你的机器上已经有使用文档及开发文档了,很详尽,参照一下,应该没啥问题。
vb操作EXCEL表的常用方法vb操作EXCEL表的常用方法VB是常用的应用软件开发工具之一,由于VB的报表功能有限,而且一但报表格式发生变化,就得相应修改程序,给应用软件的维护工作带来极大的不便。
因此有很多程序员现在已经充分利用EXECL的强大报表功来实现报表功能。
但由于VB与EXCEL由于分别属于不同的应用系统,如何把它们有机地结合在一起,是一个值得我们研究的课题。
一、 VB读写EXCEL表:VB本身提自动化功能可以读写EXCEL表,其方法如下:1、在工程中引用Microsoft Excel类型库:从"工程"菜单中选择"引用"栏;选择Microsoft Excel 9.0 Object Library(EXCEL2000),然后选择"确定"。
表示在工程中要引用EXCEL类型库。
2、在通用对象的声明过程中定义EXCEL对象:Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkBookDim xlSheet As Excel.Worksheet3、在程序中操作EXCEL表常用命令:Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象Set xlBook = xlApp.Workbooks.Open("文件名") '打开已经存在的EXCEL工件簿文件xlApp.Visible = True '设置EXCEL对象可见(或不可见)Set xlSheet = xlBook.Worksheets("表名") '设置活动工作表xlApp.Cells(row, col) =值 '给单元格(row,col)赋值XLApp.Cells(i, 1).Interior.ColorIndex = i'设计单元格颜色i=1--56xlSheet.PrintOut '打印工作表xlBook.Close (True) '关闭工作簿xlApp.Quit '结束EXCEL对象Set xlApp = Nothing '释放xlApp对象xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏xlBook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏自己用代码就可以获取颜色列表了Sub yansecode()For i = 1 To 56XlApp.Cells(i, 1) = ixlapp.Cells(i, 1).Interior.ColorIndex = iNextEnd Sub4、在运用以上VB命令操作EXCEL表时,除非设置EXCEL对象不可见,否则VB程序可继续执行其它操作,也能够关闭EXCEL,同时也可对EXCEL进行操作。
VB操作Excel报表(实例、图例、源码、注释)VB操作Excel报表(实例、图例、源码、注释)用Excel报表非常方便,而用VB操作Excel更能延长VB的功能范围。
对于重复生成的表格更是非常方便。
字体,行高,列宽,合并单元格,排版等功能都有。
供大家学习研究。
VB中使用Excel控件要先引用哦。
要不你错都不知道哪错了。
郁闷吧!一、报表预览如下1、无内容报表如下:2、填表后预览如下:测试内容,随便填的。
二、界面预览如下:打印记录按钮为Command3三、源码如下:Private Sub Command3_Click()声明一个新的Excel对象Set winkexcel = New Excel.Application该对象可见winkexcel.Visible = True选择第一张表为操作表winkexcel.SheetsInNewWorkbook = 1表添加内容Set winkworkbook = winkexcel.Workbooks.Add设置指定单元格行高列宽Set xlsheet = winkworkbook.Worksheets(1)xlsheet.Rows(1).RowHeight = 45xlsheet.Rows(2).RowHeight = 33xlsheet.Rows(3).RowHeight = 33xlsheet.Rows(4).RowHeight = 33xlsheet.Rows(5).RowHeight = 33xlsheet.Rows(6).RowHeight = 300xlsheet.Rows(7).RowHeight = 100xlsheet.Rows(8).RowHeight = 45xlsheet.Rows(9).RowHeight = 45xlsheet.Rows(10).RowHeight = 26xlsheet.Columns(1).ColumnWidth = 14xlsheet.Columns(2).ColumnWidth = 24xlsheet.Columns(3).ColumnWidth = 14xlsheet.Columns(4).ColumnWidth = 24设置表格内容的对齐方式winkexcel.ActiveSheet.Rows.HorizontalAlignment = xlVAlignCenter'水平居中winkexcel.ActiveSheet.Rows.V erticalAlignment = xlV AlignCenter'垂直居中With winkexcel.ActiveSheet.Range("A1:D1")'合并单元格.MergeEnd WithWith winkexcel.ActiveSheet.Range("B6:D6")'合并单元格.MergeEnd WithWith winkexcel.ActiveSheet.Range("B7:D7")'合并单元格.MergeEnd With画边框线,细线,黑。
用VB操作Excel(VB6.0)(整理)用VB操作Excel(VB6.0)(整理)全面控制Excel:首先创建Excel对象,使用ComObj:Dim ExcelID as Excel.ApplicationSet ExcelID as new Excel.Application1)显示当前窗口:ExcelID.Visible:=True;2)更改Excel标题栏:ExcelID.Caption:='应用程序调用MicrosoftExcel';3)添加新工作簿:ExcelID.WorkBooks.Add;4)打开已存在的工作簿:ExcelID.WorkBooks.Open('C:\Excel\Demo.xls');5)设置第2个工作表为活动工作表:ExcelID.WorkSheets[2].Activate;或ExcelID.WorkSheets['Sheet2'].Activate;6)给单元格赋值:ExcelID.Cells[1,4].Value:='第一行第四列';7)设置指定列的宽度(单位:字符个数),以第一列为例:ExcelID.ActiveSheet.Columns[1].ColumnsWidth:=5;8)设置指定行的高度(单位:磅)(1磅=0.035厘米),以第二行为例:ExcelID.ActiveSheet.Rows[2].RowHeight:=1/0.035;//1厘米9)在第8行之前插入分页符:ExcelID.WorkSheets[1].Rows[8].PageBreak:=1;10)在第8列之前删除分页符:ExcelID.ActiveSheet.Columns[4].PageBreak:=0;11)指定边框线宽度:ExcelID.ActiveSheet.Range['B3:D4'].Borders[2].Weight:=3;1-左 2-右 3-顶4-底 5-斜(\) 6-斜(/)12)清除第一行第四列单元格公式:ExcelID.ActiveSheet.Cells[1,4].ClearContents;13)设置第一行字体属性:ExcelID.ActiveSheet.Rows[1]:='隶书'; ExcelID.ActiveSheet.Rows[1].Font.Color :=clBlue; ExcelID.ActiveSheet.Rows[1].Font.Bold :=True;ExcelID.ActiveSheet.Rows[1].Font.UnderLine:=True;14)进行页面设置:a.页眉:ExcelID.ActiveSheet.PageSetup.CenterHeader:='报表演示'; b.页脚:ExcelID.ActiveSheet.PageSetup.CenterFooter:='第&P页'; c.页眉到顶端边距2cm:ExcelID.ActiveSheet.PageSetup.HeaderMargin:=2/0.035; d.页脚到底端边距3cm:ExcelID.ActiveSheet.PageSetup.HeaderMargin:=3/0.035; e.顶边距2cm:ExcelID.ActiveSheet.PageSetup.T opMargin:=2/0.035;f.底边距2cm:ExcelID.ActiveSheet.PageSetup.BottomMargin:=2/0.035; g.左边距2cm:ExcelID.ActiveSheet.PageSetup.LeftMargin:=2/0.035;h.右边距2cm:ExcelID.ActiveSheet.PageSetup.RightMargin:=2/0.035;i.页面水平居中:ExcelID.ActiveSheet.PageSetup.CenterHorizontally:=2/0.035; j.页面垂直居中:ExcelID.ActiveSheet.PageSetup.CenterVertically:=2/0.035; k.打印单元格网线:ExcelID.ActiveSheet.PageSetup.PrintGridLines:=True;15)拷贝操作:a.拷贝整个工作表:ed.Range.Copy;b.拷贝指定区域:ExcelID.ActiveSheet.Range['A1:E2'].Copy;c.从A1位置开始粘贴:ExcelID.ActiveSheet.Range.['A1'].PasteSpecial;d.从文件尾部开始粘贴:ExcelID.ActiveSheet.Range.PasteSpecial;16)插入一行或一列:a.ExcelID.ActiveSheet.Rows[2].Insert;b.ExcelID.ActiveSheet.Columns[1].Insert;17)删除一行或一列:a.ExcelID.ActiveSheet.Rows[2].Delete;b.ExcelID.ActiveSheet.Columns[1].Delete;18)打印预览工作表:ExcelID.ActiveSheet.PrintPreview;19)打印输出工作表:ExcelID.ActiveSheet.PrintOut;20)工作表保存:IfnotExcelID.ActiveWorkBook.SavedthenExcelID.ActiveSheet.PrintPreviewEndif21)工作表另存为:ExcelID.SaveAs('C:\Excel\Demo1.xls');22)放弃存盘:ExcelID.ActiveWorkBook.Saved:=True;23)关闭工作簿:ExcelID.WorkBooks.Close;24)退出Excel:ExcelID.Quit;25)设置工作表密码:ExcelID.ActiveSheet.Protect"123",DrawingObjects:=True,Con tents:=True,Scenarios:=True26)EXCEL的显示方式为最大化ExcelID.Application.WindowState=xlMaximized27)工作薄显示方式为最大化ExcelID.ActiveWindow.WindowState=xlMaximized28)设置打开默认工作薄数量ExcelID.SheetsInNewWorkbook=329)'关闭时是否提示保存(true保存;false不保存)ExcelID.DisplayAlerts=False30)设置拆分窗口,及固定行位置ExcelID.ActiveWindow.SplitRow=1ExcelID.ActiveWindow.FreezePanes=True31)设置打印时固定打印内容ExcelID.ActiveSheet.PageSetup.PrintTitleRows="$1:$1"32)设置打印标题ExcelID.ActiveSheet.PageSetup.PrintTitleColumns=""33)设置显示方式(分页方式显示)ExcelID.ActiveWindow.View=xlPageBreakPreview34)设置显示比例ExcelID.ActiveWindow.Zoom=10035)让Excel响应DDE请求Ex.Application.IgnoreRemoteRequests=False用VB操作EXCEL示例代码Private Sub Command3_Click()On Error GoTo err1Dim i As LongDim j As LongDim objExl As Excel.Application '声明对象变量Me.MousePointer=11 '改变鼠标样式Set objExl=New Excel.Application'初始化对象变量objExl.SheetsInNewWorkbook=1 '将新建的工作薄数量设为1 objExl.Workbooks.Add'增加一个工作薄objExl.Sheets(objExl.Sheets.Count).Name="book1" '修改工作薄名称objExl.Sheets.Add,objExl.Sheets("book1")‘增加第二个工作薄在第一个之后objExl.Sheets(objExl.Sheets.Count).Name="book2"objExl.Sheets.Add,objExl.Sheets("book2")‘增加第三个工作薄在第二个之后objExl.Sheets(objExl.Sheets.Count).Name="book3"objExl.Sheets("book1").Select '选中工作薄<book1>For i=1 To 50'循环写入数据For j=1 To 5If i=1 ThenobjExl.Selection.NumberFormatLocal="@" '设置格式为文本objExl.Cells(i,j)="E"&i&jElseobjExl.Cells(i,j)=i&jEndIfNextNextobjExl.Rows("1:1").Select '选中第一行objExl.Selection.Font.Bold=True '设为粗体objExl.Selection.Font.Size=24 '设置字体大小objExl.Cells.EntireColumn.AutoFit '自动调整列宽objExl.ActiveWindow.SplitRow=1 '拆分第一行objExl.ActiveWindow.SplitColumn=0 '拆分列objExl.ActiveWindow.FreezePanes=True '固定拆分objExl.ActiveSheet.PageSetup.PrintTitleRows="$1:$1" '设置打印固定行objExl.ActiveSheet.PageSetup.PrintTitleColumns=""'打印标题objExl.ActiveSheet.PageSetup.RightFooter="打印时间:"&_ Format(Now,"yyyy年mm月dd日hh:MM:ss")objExl.ActiveWindow.View=xlPageBreakPreview'设置显示方式objExl.ActiveWindow.Zoom=100 '设置显示大小'给工作表加密码objExl.ActiveSheet.Protect"123",DrawingObjects:=True, _Contents:=True,Scenarios:=TrueobjExl.Application.IgnoreRemoteRequests=FalseobjExl.Visible=True '使EXCEL可见objExl.Application.WindowState=xlMaximized'EXCEL的显示方式为最大化objExl.ActiveWindow.WindowState=xlMaximized'工作薄显示方式为最大化objExl.SheetsInNewWorkbook=3 '将默认新工作薄数量改回3个Set objExl=Nothing'清除对象Me.MousePointer=0 '修改鼠标ExitSuberr1:objExl.SheetsInNewWorkbook=3objExl.DisplayAlerts=False '关闭时不提示保存objExl.Quit'关闭EXCELobjExl.DisplayAlerts=True '关闭时提示保存Set objExl=NothingMe.MousePointer=0End Sub。
VB中操作Excel的一般做法(读取)- 中国WEB开发者网络 ()-- 技术教程 (/article/)--- VB中操作Excel的一般做法(读取)(/article/28/27242.htm) -- 作者:未知-- 发布日期: 2006-02-07【VB源码】vb6.0中读取excel中的数据来源:初月岛发布时间:2010-03-08 查看次数:326vb6.0中读取excel中的数据,并把数据填写到vb中的textbox上实例:Private Sub Command3_Click()Dim Conn As New ADODB.ConnectionDim rs As New ADODB.RecordsetDim i As IntegerDim sql As String'On Error Resume NextstrName = App.Path & "\\book.xls" 'EXCEL文件名strSheetName = "sheet1" 'EXCEL表名Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist SecurityInfo=False;Data Source=" & strName & ";Extended Properties='Excel 8.0;HDR=Yes'" '连接EXCEL文件sql = "select. * from [" & strSheetName & "$]" '打开EXCEL表rs.Open sql, Conn, 3, 3MsgBox rs.RecordCount '显示表里的记录数Do Until rs.EOFFor i = 0 To rs.Fields.Count - 1 '读一行数据List1.AddItem rs.Fields.Item(i).Name '读出数据,添加到list1里If Not IsNull(rs.Fields.Item(i).Value) ThenList2.AddItem rs.Fields.Item(i).ValueElsers.Updaters.Fields.Item(i).Value = i ' "peter" & irs.UpdateEnd IfNext irs.MoveNextLooprs.Close '关闭数据集Conn.Close '关闭对象End SubVBA数据类型概述以下表格显示所支持的数据类型,以及存储空间大小与范围。
VB Excel 导入导出(原创)导入:If Grid1.rows > 0 ThenDim appp As StringCommonDialog1.Filter = "工作薄|*.xls" CommonDialog1.ShowOpenIf CommonDialog1.FileName <> "" Thenappp = CommonDialog1.FileNameEnd IfGrid1.Cols = 1Grid1.rows = 1Grid1.AutoRedraw = FalseDim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlsheet As Excel.WorksheetIf Dir(appp) <> "" ThenSet xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(appp) Set xlsheet = xlBook.Worksheets(1)xlsheet.ActivateDim i As LongDim rows As LongDim counhead As Longi = 1Dim str As StringDim str2 As Stringstr = "a"str2 = "a"Do While str <> "" And str2 <> ""If str <> "" Thenstr = xlsheet.Cells(i, 1)End IfIf str <> "" Thenstr2 = xlsheet.Cells(1, i)End Ifi = i + 1Looprows = i - 3Grid1.rows = rows + 1counhead = i - 2Grid1.Cols = counhead + 1Dim test As LongFor test = 1 To counheadGrid1.Cell(0, test).Text = xlsheet.Cells(1, test) NextDim ii As LongDim iii As LongFor ii = 2 To rows + 1iii = iii + 1For test = 1 To counheadGrid1.Cell(iii, test).Text = xlsheet.Cells(ii, test)NextNextxlApp.Workbooks.CloseGrid1.AutoRedraw = TrueGrid1.RefreshElseMsgBox ("当前没有可导出数据")End If导出:If Grid1.rows > 0 ThenDim appp As StringCommonDialog1.Filter = "工作薄|*.xls" CommonDialog1.ShowOpenIf CommonDialog1.FileName <> "" Then appp = CommonDialog1.FileNameEnd IfDim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlsheet As Excel.WorksheetIf Dir(appp) = "" ThenSet xlApp = CreateObject("Excel.Application") auto_open (appp)xlApp.Visible = TrueSet xlBook = xlApp.Workbooks.Open(appp) Set xlsheet = xlBook.Worksheets(1) xlsheet.ActivateDim i As LongDim ii As LongFor i = 1 To Grid1.Cols - 1xlsheet.Cells(1, i) = Grid1.Cell(0, i).TextNextDim iii As LongDim test As LongFor ii = 2 To Grid1.rowsiii = iii + 1For test = 1 To Grid1.Cols - 1xlsheet.Cells(ii, test) = Grid1.Cell(iii, test).Text NextNextxlApp.Workbooks.CloseKill (appp)Call NiceButton1_Click '此处用递归End IfElseMsgBox ("当前没有可导出数据") End If。
Private Sub cmdSwatch_Click()Dim xls As excel.ApplicationDim xlbook As excel.Workbook'On Error GoTo exlErrorDim i As IntegerIf Dir(Text1.Text) <> "" Then '此目录下如有同名文件给出提示,并作相应处理If MsgBox("文件已存在,是否覆盖!", vbYesNo + vbQuestion, "另存为工程造价文件") = vbNo Then Exit SubElseKill (Text1.Text) '删除文件End IfEnd If'************打开工作表***************Set xls = New excel.Applicationxls.Visible = TrueSet xlbook = xls.Workbooks.Add'*********************************For i = 0 To 14If Check2(i).Value = vbChecked ThenSelect Case iCase 8ToExcelJDanJiaSum.ToExcelJDanJiaSum xlbook, xlsCase 9ToExcelADanJiaSum.ToExcelADanJiaSum xlbook, xlsCase 10ToExcelCailiao.ToExcelCailiao xlbook, xlsCase 11ToExcelTsf.ToExcelTsf xlbook, xlsCase 12ToExcelZgcl.ToExcelZgcl xlbook, xlsEnd SelectEnd IfNextFor i = 0 To 6If Check3(i).Value = vbChecked ThenSelect Case iCase 0ToExcelMan.ToExcelMan xlbook, xlsCase 1ToExcelFSD_CL.ToExcelFSD_CL xlbook, xls Case 2ToExcelHNT.ToExcelHNT xlbook, xlsCase 3ToExcelZsf.ToExcelZsf xlbook, xlsCase 4ToExcelJingChang.ToExcelJingChang xlbook, xls Case 5ToExcelJDanJia.ToExcelJDanJia xlbook, xls Case 6ToExcelADanJia.ToExcelADanJia xlbook, xls End SelectEnd IfNextxlbook.SaveAs Text1.Text '保存EXCEL文件'***************************关闭EXCEL对象*******************If Check1.Value = vbChecked Thenxlbook.Closexls.QuitEnd IfSet xlbook = NothingSet xls = NothingExit Sub'exlError:' MsgBox Err.Description, vbOKOnly + vbCritical, "警告"End SubOption ExplicitPublic Sub ToExcelZgcl(ByRef xlbook, ByRef xls) '输出总工程量Dim con As New ADODB.ConnectionDim rst_gcl As New ADODB.RecordsetDim rst_qm As New ADODB.Recordset'**************************连接数据库****************************************con.CursorLocation = adUseClientcon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"con.Openrst_gcl.Open "zonggcl", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开工程量汇总表If Not (rst_gcl.BOF And rst_gcl.EOF) Thenrst_gcl.MoveFirstEnd Ifrst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开签名表rst_qm.MoveFirst'****************************工作表初使化*********************************** Dim xlsheet As excel.WorksheetSet xlsheet = xlbook.Sheets.Add '添加一张工作表 = "工程量汇总"xls.ActiveSheet.PageSetup.Orientation = xlLandscape '纸张设置为横向xlsheet.Columns("a:j").Font.Size = 10xlsheet.Columns("a:j").VerticalAlignment = xlVAlignCenter '垂直居中xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐xlsheet.Columns(1).ColumnWidth = 8xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeftxlsheet.Columns(2).ColumnWidth = 26xlsheet.Columns("c:j").HorizontalAlignment = xlHAlignRightxlsheet.Columns("c:j").ColumnWidth = 10xlsheet.Columns("c:j").NumberFormatLocal = "0.00_ " '3到10列保留两位小数'***************************写入标头************************************* xlsheet.Rows(1).RowHeight = 40xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 10)).MergeCells = Truexlsheet.Cells(1, 1).Value = "工程量汇总"xlsheet.Cells(1, 1).Font.Size = 14xlsheet.Cells(1, 1).Font.Bold = Truexlsheet.Rows(2).RowHeight = 18xlsheet.Rows(2).HorizontalAlignment = xlHAlignCenterxlsheet.Cells(2, 1).Value = "序号"xlsheet.Cells(2, 2).Value = "工程项目及名称"xlsheet.Cells(2, 3).Value = "土方开挖(m3)"xlsheet.Cells(2, 4).Value = "石方开挖(m3)"xlsheet.Cells(2, 5).Value = "土方回填(m3)"xlsheet.Cells(2, 6).Value = "洞挖石方(m3)"xlsheet.Cells(2, 7).Value = "砼浇筑(m3)"xlsheet.Cells(2, 8).Value = "钢筋制安(t)"xlsheet.Cells(2, 9).Value = "砌石工程(m3)"xlsheet.Cells(2, 10).Value = "灌浆工程(m)"xls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$2" '固定表头'***************************写入内容*************************Dim i As Integeri = 3 'i控制行Dim j As Integer 'j控制列Dim countpage As Integercountpage = 0 '控制页Do While Not rst_gcl.EOFxlsheet.Rows(i).RowHeight = 18 '控制行高For j = 1 To 10xlsheet.Cells(i, j) = rst_gcl.Fields(j) '将工程理库中的一条记录的第一个字段写入工作表中Next'每18行为一页,如果数据超出一页时进行特殊处理If i > 18 Thenxls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行End IfIf i Mod 18 = 0 ThenIf countpage = 0 Thenxlsheet.Range(xlsheet.Cells(2, 1), xlsheet.Cells(i, 10)).Borders.LineStyle = xlContinuous '首页加边框Elsexlsheet.Range(xlsheet.Cells(23 + (countpage - 1) * 18, 1), xlsheet.Cells(i, 10)).Borders.LineStyle = xlContinuous '中间页加边框End Ifi = i + 2 '加一条空行'******************************在非尾页写入签名**************************************xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(64) & rst_qm.Fields(0)xlsheet.Rows(i).RowHeight = 30i = i + 1 '换行xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(50) & rst_qm.Fields(1)xlsheet.Rows(i).RowHeight = 15i = i + 1xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(55) & rst_qm.Fields(2)xlsheet.Rows(i).RowHeight = 30'****************************************************************************xlsheet.HPageBreaks.Add (xlsheet.Rows(i + 1)) '添加分页符countpage = countpage + 1 '换页End Ifi = i + 1rst_gcl.MoveNextLoopxlsheet.Range(xlsheet.Cells(23 + (countpage - 1) * 18, 1), xlsheet.Cells(i - 1, 10)).Borders.LineStyle = xlContinuous '尾页加边框i = i + 1 '加入一空行'*********************************在尾页加签名*************************************** xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(64) & rst_qm.Fields(0)xlsheet.Rows(i).RowHeight = 30i = i + 1 '换行xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(50) & rst_qm.Fields(1)xlsheet.Rows(i).RowHeight = 15i = i + 1xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = Truexlsheet.Cells(i, 1).Value = Space(55) & rst_qm.Fields(2)xlsheet.Rows(i).RowHeight = 30'*********************************************************************************** xls.ActiveWindow.View = xlPageBreakPreview '分页预览xls.ActiveWindow.Zoom = 100If con.State = adStateOpen Thenrst_gcl.Closerst_qm.CloseSet rst_gcl = NothingSet rst_qm = Nothingcon.CloseSet con = NothingEnd IfSet xlsheet = NothingEnd SubOption ExplicitPublic Sub ToExcelTsf(ByRef xlbook, ByRef xls)Dim con As New ADODB.ConnectionDim rst_tsf As New ADODB.RecordsetDim rst_qm As New ADODB.Recordset'**********************************连接数据库************************con.CursorLocation = adUseClientcon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"con.Openrst_tsf.Open "tdefeiyong", con, adOpenKeyset, adLockOptimistic, adCmdTableIf Not (rst_tsf.BOF And rst_tsf.EOF) Thenrst_tsf.MoveFirstEnd Ifrst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTablerst_qm.MoveFirst'*********************************工作表初使化**********************************Dim xlsheet As excel.WorksheetSet xlsheet = xlbook.Sheets.Add = "机械台时、组时费汇总表"xlsheet.Columns(1).ColumnWidth = 5xlsheet.Columns(2).ColumnWidth = 20xlsheet.Columns(3).ColumnWidth = 7xlsheet.Columns(4).ColumnWidth = 7xlsheet.Columns(5).ColumnWidth = 7xlsheet.Columns(6).ColumnWidth = 7xlsheet.Columns(7).ColumnWidth = 7xlsheet.Columns(8).ColumnWidth = 7xlsheet.Columns(9).ColumnWidth = 7xlsheet.Columns("A:I").Font.Size = 9xlsheet.Columns("A:I").VerticalAlignment = xlVAlignCenter '垂直居中xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeft '2列水平左对齐'******************************写入标头************************************ xlsheet.Rows(1).RowHeight = 35xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 9)).MergeCells = Truexlsheet.Cells(1, 1).Font.Size = 14xlsheet.Cells(1, 1).Font.Bold = Truexlsheet.Cells(1, 1).Value = "机械台时、组时费汇总表"xlsheet.Cells(2, 9).Value = "单位:元"xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(5, 1)).MergeCells = Truexlsheet.Cells(3, 1).Value = "编号"xlsheet.Range(xlsheet.Cells(3, 2), xlsheet.Cells(5, 2)).MergeCells = Truexlsheet.Cells(3, 2).Value = "机械名称"xlsheet.Range(xlsheet.Cells(3, 3), xlsheet.Cells(5, 3)).MergeCells = Truexlsheet.Cells(3, 3).Value = "台时费"xlsheet.Range(xlsheet.Cells(3, 4), xlsheet.Cells(3, 9)).MergeCells = Truexlsheet.Cells(3, 4).Value = "其中"xlsheet.Range(xlsheet.Cells(3, 3), xlsheet.Cells(5, 3)).MergeCells = Truexlsheet.Cells(3, 3).Value = "台时费"xlsheet.Range(xlsheet.Cells(4, 4), xlsheet.Cells(5, 4)).MergeCells = Truexlsheet.Cells(4, 4).Value = "折旧费"xlsheet.Range(xlsheet.Cells(4, 5), xlsheet.Cells(5, 5)).MergeCells = Truexlsheet.Cells(4, 5).Value = "修理替换费"xlsheet.Range(xlsheet.Cells(4, 6), xlsheet.Cells(5, 6)).MergeCells = Truexlsheet.Cells(4, 6).Value = "安拆费"xlsheet.Range(xlsheet.Cells(4, 7), xlsheet.Cells(5, 7)).MergeCells = Truexlsheet.Cells(4, 7).Value = "人工费"xlsheet.Range(xlsheet.Cells(4, 8), xlsheet.Cells(5, 8)).MergeCells = Truexlsheet.Cells(4, 8).Value = "燃料费"xlsheet.Range(xlsheet.Cells(4, 9), xlsheet.Cells(5, 9)).MergeCells = Truexlsheet.Cells(4, 9).Value = "其他费"xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(5, 9)).HorizontalAlignment = xlHAlignCenterxls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$5" '固定表头'****************************************写入内容************************************* Dim i As Integeri = 6Do While Not rst_tsf.EOFxlsheet.Cells(i, 1).Value = rst_tsf.Fields("nn")xlsheet.Cells(i, 2).Value = rst_tsf.Fields("name")xlsheet.Cells(i, 3).Value = rst_tsf.Fields("price")xlsheet.Cells(i, 4).Value = rst_tsf.Fields("zhejiu")xlsheet.Cells(i, 5).Value = rst_tsf.Fields("xiuli")xlsheet.Cells(i, 6).Value = rst_tsf.Fields("anchai")xlsheet.Cells(i, 7).Value = rst_tsf.Fields("rengong")xlsheet.Cells(i, 8).Value = rst_tsf.Fields("dongli")xlsheet.Cells(i, 9).Value = rst_tsf.Fields("qita")If i > 22 Thenxls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行End Ifi = i + 1rst_tsf.MoveNextLoopxlsheet.Range(xlsheet.Cells(6, 3), xlsheet.Cells(i - 1, 9)).NumberFormatLocal = "0.00_ " '保留两位小数'*********************************添加边框********************************** xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(i - 1, 9)).Borders.LineStyle = xlContinuous '****************************************************************************** xls.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(2.2) '设置下侧面边距xls.ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(1) '设置页脚高xls.ActiveSheet.PageSetup.CenterFooter = "&10" & rst_qm.Fields(0) & Chr(10) & Chr(10) &rst_qm.Fields(1) & Chr(10) & Chr(10) & rst_qm.Fields(2) '加页脚xls.ActiveWindow.View = xlPageBreakPreview '分页预览xls.ActiveWindow.Zoom = 100'***************************关闭记录集******************* If con.State = adStateOpen Thenrst_tsf.Closerst_qm.CloseSet rst_tsf = NothingSet rst_qm = Nothingcon.CloseSet con = NothingEnd IfSet xlsheet = NothingEnd Sub精彩的后续作者Blog:/mi6236/。