如何将VB中的数据导出excel,word中去!

最新推荐文章于 2019-01-19 16:02:22 发布

方承司南

最新推荐文章于 2019-01-19 16:02:22 发布

阅读量8k

点赞数

分类专栏： Visual Basic 文章标签： excel vb datagrid 工作 integer function

Visual Basic 专栏收录该内容

17 篇文章 0 订阅

订阅专栏

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 Function
FillError:
     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.Recordset
　　Set 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 Sub
ExcelError:
     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:/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].Font.Name   :=   '隶书';
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.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.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   then
        ExcelID.ActiveSheet.PrintPreview
        End   if
21)   工作表另存为：
      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:=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           '选中工作薄<book1>
          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   document's   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.Alignment   =   wdAlignParagraphCenter
End   With

'   Show   Word   to   the   user
oWord.Visible   =   True

If   oldRec   >=   1   Then
adc_card.Recordset.MoveFirst
adc_card.Recordset.Move   oldRec   -   1
End   If

'CheckBox   on   form   says   "立即打印"
If   Check1   Then   oWord.PrintOut
-------------------------------------------------------------------------------------------

datagrid   导出到   EXCEL


Private   Sub   Command1_Click()
Dim   i   As   Integer
Dim   j   As   Integer
Dim   xlApp   As   New   Excel.Application
Dim   xlBook   As   New   Excel.Workbook
Dim   xlSheet   As   New   Excel.Worksheet
Set   xlApp   =   CreateObject("Excel.Application")
xlApp.Visible   =   True
Set   xlBook   =   xlApp.Workbooks.add
On   Error   Resume   Next
Set   xlBook   =   xlApp.Workbooks.Open("d:/text2.xls")
Set   xlSheet   =   xlBook.Worksheets(1)
For   j   =   0   To   mgrid.Columns.Count   -   1
xlSheet.Cells(1,   j   +   1)   =   mgrid.Columns.Item(j).Caption
Next   j
xlSheet.Cells(6,   1)   =   "i"
Adodc1.Recordset.MoveFirst
For   i   =   0   To   Adodc1.Recordset.RecordCount   -   1
mgrid.Row   =   i
For   j   =   0   To   mgrid.Columns.Count   -   1
mgrid.Col   =   j
'MsgBox   DataGrid1.Text

If   IsNull(mgrid.Text)   =   False   Then
xlSheet.Cells(i   +   2,   j   +   1)   =   mgrid.Text
End   If
Next   j
Next   i

End   Sub
------------------------------------------------------------------------------------------