VB中的数据导出excel,word中去.doc

VB: 怎样将查询结果导出到Excel 如果你想将查询结果导出到Excel另存，以便日后查看或打印的话，那么我这里说的就是怎样将查询结果导出到Excel。先来写一个函数FillDataArray，该函数的主要作用是将查询语句中的字段名和查到的记录导入到Excel中。 Public Function FillDataArray(asArray(), adoRS As ADODB.Recordset) As Long 将数据送 Excel 函数 Dim nRow As Integer Dim nCol As Integer On Error GoTo FillError ReDim asArray(100000, adoRS.Fields.Count) nRow = 0 For nCol = 0 To adoRS.Fields.Count - 1 asArray(nRow, nCol) = adoRS.Fields(nCol).name Next nCol nRow = 1 Do While Not adoRS.EOF For nCol = 0 To adoRS.Fields.Count - 1 asArray(nRow, nCol) = adoRS.Fields(nCol).Value Next nCol adoRS.MoveNext nRow = nRow + 1 Loop nRow = nRow + 1 FillDataArray = nRow Exit FunctionFillError: MsgBox Error$ Exit Function Resume End Function 然后再来写一个过程PrintList，来调用前面的这个函数。 Private Sub PrintList() Dim strSource, strDestination As String Dim asTempArray() Dim INumRows As Long Dim objExcel As Excel.Application Dim objRange As Excel.Range On Error GoTo ExcelError Set objExcel = New Excel.Application 新建一个Excel Dim rs As New ADODB.RecordsetSet rs = Conn.Execute(sqlall)sqlall是查询语句 If Not rs.EOF Then objExcel.Workbooks.Open App.Path & vvv.xls MsgBox 查询结果导出后，请将其另存为一个.xls文件，使vvv.xls中的内容为空，确保后面查询结果的正确导出。 INumRows = FillDataArray(asTempArray, rs) 调填充数组函数 objExcel.cells(1, 1) = 查询结果 填表头 Set objRange = objExcel.Range(objExcel.cells(2, 1), objExcel.cells(INumRows, rs.Fields.Count) objRange.Value = asTempArray 填数据 End If objExcel.Visible = True 显示Excel objExcel.DisplayAlerts = True 提示保存Excel Exit SubExcelError: If Err 432 And Err 0 Then MsgBox Error$ Set objExcel = Nothing Exit Sub Else Resume Next End If End Sub其中用到的vvv.xls必须是先建好了的xls文件。结果导出后不要直接保存，而要将其另存为一个.xls文件，使vvv.xls中的内容为空，确保后面查询结果的正确导出?-如何操作Excel文件 全面控制 Excel 首先创建 Excel 对象，使用ComObj: Dim ExcelID as Excel.Application Set ExcelID as new Excel.Application 1) 显示当前窗口： ExcelID.Visible := True; 2) 更改 Excel 标题栏： ExcelID.Caption := 应用程序调用 Microsoft Excel; 3) 添加新工作簿： ExcelID.WorkBooks.Add; 4) 打开已存在的工作簿： ExcelID.WorkBooks.Open( C:ExcelDemo.xls ); 5) 设置第2个工作表为活动工作表： ExcelID.WorkSheets2.Activate; 或 ExcelID.WorkSheets Sheet2 .Activate; 6) 给单元格赋值： ExcelID.Cells1,4.Value := 第一行第四列; 7) 设置指定列的宽度（单位：字符个数），以第一列为例： ExcelID.ActiveSheet.Columns1.ColumnsWidth := 5; 8) 设置指定行的高度（单位：磅）（1磅0.035厘米），以第二行为例： ExcelID.ActiveSheet.Rows2.RowHeight := 1/0.035; / 1厘米 9) 在第8行之前插入分页符： ExcelID.WorkSheets1.Rows8.PageBreak := 1; 10) 在第8列之前删除分页符： ExcelID.ActiveSheet.Columns4.PageBreak := 0; 11) 指定边框线宽度： ExcelID.ActiveSheet.Range B3:D4 .Borders2.Weight := 3; 1-左 2-右 3-顶 4-底 5-斜( ) 6-斜( / ) 12) 清除第一行第四列单元格公式： ExcelID.ActiveSheet.Cells1,4.ClearContents; 13) 设置第一行字体属性： ExcelID.ActiveSheet.Rows1.Font.Name := 隶书; ExcelID.ActiveSheet.Rows1.Font.Color := clBlue; ExcelID.ActiveSheet.Rows1.Font.Bold := True; ExcelID.ActiveSheet.Rows1.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.TopMargin := 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.拷贝整个工作表： ExcelID.ActiveSheet.Used.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.Rows2.Insert; b. ExcelID.ActiveSheet.Columns1.Insert; 17) 删除一行或一列： a. ExcelID.ActiveSheet.Rows2.Delete; b. ExcelID.ActiveSheet.Columns1.Delete; 18) 打印预览工作表： ExcelID.ActiveSheet.PrintPreview; 19) 打印输出工作表： ExcelID.ActiveSheet.PrintOut; 20) 工作表保存： If not ExcelID.ActiveWorkBook.Saved then ExcelID.ActiveSheet.PrintPreview End if 21) 工作表另存为： ExcelID.SaveAs( C:ExcelDemo1.xls ); 22) 放弃存盘： ExcelID.ActiveWorkBook.Saved := True; 23) 关闭工作簿： ExcelID.WorkBooks.Close; 24) 退出 Excel： ExcelID.Quit; 25) 设置工作表密码: ExcelID.ActiveSheet.Protect 123, DrawingObjects:=True, Contents:=True, Scenarios:=True 26) EXCEL的显示方式为最大化 ExcelID.Application.WindowState = xlMaximized 27) 工作薄显示方式为最大化 ExcelID.ActiveWindow.WindowState = xlMaximized 28) 设置打开默认工作薄数量 ExcelID.SheetsInNewWorkbook = 3 29) 关闭时是否提示保存(true 保存；false 不保存) ExcelID.DisplayAlerts = False 30) 设置拆分窗口,及固定行位置 ExcelID.ActiveWindow.SplitRow = 1 ExcelID.ActiveWindow.FreezePanes = True 31) 设置打印时固定打印内容 ExcelID.ActiveSheet.PageSetup.PrintTitleRows = $1:$1 32) 设置打印标题 ExcelID.ActiveSheet.PageSetup.PrintTitleColumns = 33) 设置显示方式(分页方式显示) ExcelID.ActiveWindow.View = xlPageBreakPreview 34) 设置显示比例 ExcelID.ActiveWindow.Zoom = 100 35) 让Excel 响应 DDE 请求 Ex.Application.IgnoreRemoteRequests = False 用VB操作EXCEL Private Sub Command3_Click() On Error GoTo err1 Dim i As Long Dim j As Long Dim 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 选中工作薄 For i = 1 To 50 循环写入数据 For j = 1 To 5 If i = 1 Then objExl.Selection.NumberFormatLocal = 设置格式为文本 objExl.Cells(i, j) = E & i & j Else objExl.Cells(i, j) = i & j End If Next Next objExl.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:=True objExl.Application.IgnoreRemoteRequests = False objExl.Visible = True 使EXCEL可见 objExl.Application.WindowState = xlMaximized EXCEL的显示方式为最大化 objExl.ActiveWindow.WindowState = xlMaximized 工作薄显示方式为最大化 objExl.SheetsInNewWorkbook = 3 将默认新工作薄数量改回3个 Set objExl = Nothing 清除对象 Me.MousePointer = 0 修改鼠标 Exit Sub err1: objExl.SheetsInNewWorkbook = 3 objExl.DisplayAlerts = False 关闭时不提示保存 objExl.Quit 关闭EXCEL objExl.DisplayAlerts = True 关闭时提示保存 Set objExl = Nothing Me.MousePointer = 0 End Sub -利用 Word 打印的例子 Dim oWord As Word.Application Dim oDoc As Word.Document Dim oRange As Word.Range Dim sTemp, sHeadline, sTitle As String Dim i As Integer Dim oldRec As Long On Error GoTo eh If adc_card.Recordset.RecordCount = 0 Then MsgBox 没有可打印的数据！, vbCritical: Exit Sub oldRec = adc_card.Recordset.AbsolutePosition Create an instance of Word Set oWord = CreateObject(Word.Application) Add a new, blank document Set oDoc = oWord.Documents.add oDoc.PageSetup.Orientation = wdOrientLandscape Get the current documents range object Set oRange = oDoc.Range sTitle = Format(DTPicker1.value, yyyy年mm月dd日) & Combo1 & IIf(Len(Text4), （, ) & Text4 & IIf(Len(Text4), ）, ) & 消费记录明细表 & vbCrLf & vbCrLf oRange.Text = sTitle oRange.SetRange Len(sTitle) + 1, Len(sTitle) + 1 adc_card.Recordset.MoveFirst sTemp = adc_card.Recordset.GetString(adClipString, -1, vbTab) For i = 0 To Datagrid1.Columns.Count - 1 sHeadline = sHeadline & Datagrid1.Columns(i).Caption & vbTab Next i sHeadline = Left(sHeadline, Len(sHeadline) - 1) & vbCrLf Insert a heading on the string sTemp = sHeadline & sTemp Insert the data into the Word document oRange.Text = sTemp Convert the text to a table and format the table oRange.ConvertToTable vbTab, , , , 36 oRange.SetRange oRange.End + 1, oRange.End + 1 oRange.Text = vbCrLf & 制表人： & AdminName & vbTab & vbTab _ & 制表日期： & Format(Date, long date) oRange.ParagraphFormat.Alignment = wdAlignParagraphRight oDoc.Tables(1).Select With oWord.Selection .Cells.HeightRule = wdRowHeightAtLeast .Cells.Height = 16 .Cells.VerticalAlignment = wdCellAlignVerticalCenter End With oDoc.Tables(1).Columns(2).Width = 40 oDoc.Tables(1).Columns(8).Width = oDoc.Tables(1).Columns(8).Width + 50 For i = 2 To adc_card.Recordset.RecordCount + 1 oDoc.Tables(1).Cell(i, 4).Select oWord.Selection.Text = Format(Val(oWord.Selection.Text), currency) Next i oDoc.Tables(1).Cell(1, 4).Select oWord.Selection.SelectColumn oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight oDoc.Tables(1).Cell(1, 4).Select oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft oWord.Selection.HomeKey Unit:=wdStory Formating the Title oRange.SetRange 0, Len(sTitle) - 4 With oRange .Font.Name = 宋体 .Font.size = 16 .Font.Bold = True .ParagraphFormat.Al