VB中使用EXCEL输出
VB对excel操作的方法总汇教程
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实现读取写入打印
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导出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）
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的方法
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并设置纸张为A4
用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数据导入和导出的实用方法
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操作的实例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 计算成绩：二年级略。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
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/。