Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称:ExporToExcel
'* 功能:导出数据到EXCEL
'* 用法:ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = Cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strOpen
        .Open
    End With
  '  Rs_Data.Open strOpen, Cn, adOpenStatic, adLockReadOnly
    With Rs_Data
      '  .MoveFirst
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    '添加查询语句,导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
'    With xlSheet.PageSetup
'        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称:"   ' & Gsmc
'        .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期:"
'        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位:"
'        .LeftFooter = "&""楷体_GB2312,常规""&10制表人:"
'        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期:"
'        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
'    End With
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function

解决方案 »

  1.   

    在VB 中控制 Word 
    Word 提供了一个 Word 对象, 通过在 “引用” 中的该对象, 可以实现对 Word 的控制。 以下的代码演示了执行 WordBasic 语句,该段代码是动态引用对象, 无须在工程中引用Word 对象。Dim wd As Object
    Set wd = CreateObject ("Word.Basic")
    wd.FileNewDefault
    wd.FontSize 20
    wd.Insert "Hello, World"
    wd.FileSaveAs "Hello.Doc"
    wd.FileClose
    Set wd = Nothing执行后,将产生一个 Hello.Doc 。 一个种办法是在 Word 中调试好 WordBasic 语句后, 再发布到 VB 中。类似的处理应该也可以用在 Execl 中。 
      

  2.   

    巧用VBA自动处理Word表格Microsoft Word 97是大家熟悉的文字处理软件,强大的功能为我们的工作提供了很大的帮助。而Visual Basic for Applications(VBA)的应用更为Word 97增添了不少特色,合理而恰当地使用VBA可为用户提供极大的方便。下面介绍几则使用VBA编程自动处理Word表格的例子。
      1. 创建表格,插入文字
      本例的功能是在文档开头插入一张 3 行 4 列的表格。可用For Each...Next 结构来循环遍历表格中的每个单元格。在 For Each...Next 结构中,InsertAfter 方法用来向表格单元格添加文字("第 1 单元格"、" 第 2 单元格"等等),oTable.AutoFormat属性用于指定表格套用格式。运行结果如图1:
    @@0869600.JPG;图1@@
      Set oDoc = ActiveDocument
      Set oTable= oDoc.Tables.Add(Range:=oDoc.Range(Start:=0, End:=0), NumRows
    :=3,NumColumns:=4)
      iCount = 1
      For Each oCell In oTable.Range.Cells
      oCell.Range.InsertAfter "第 "& iCount & "单元格"
      iCount = iCount + 1
      Next oCell
      oTable.AutoFormat Format:=wdTableFormatColorful2,ApplyBorders:=True, App
    lyFont:=True, ApplyColor:=True
      2. 在表格的列、行插入序号
      1. 如果需要在表格的第一列插入序号,只需将 For Each...Next 结构中的内容改为下述程序行即可,其中InsertAfter 方法用来向表格单元格添加序号("第 1 行"、" 第2 行"等等)。
      If iCount Mod 4 = 1 Then
       oCell.Range.InsertAfter"第 " & (iCount - 1) / 4 + 1 & " 行"
      End If
      iCount = iCount + 1
      2. 如果需要从表格的第二行开始插入序号,应将上述代码改为:
      If iCount Mod 4 = 1 And iCount > 4 Then
       oCell.Range.InsertAfter "第 "& (iCount - 1) / 4 & "行"
      End If
      iCount = iCount + 1
      3. 在表格的列插入日期
      (1) 如需在表格的第一列插入日期, 可用For Each...Next结构来循环遍历表格中的每个单元格,当判断某一单元格为第一列时,插入日期。Formart(Date,...)用于指定日期的格式,下面例子中的日期从Date+1(即当前日期第二天)开始,用户可以根据需要自定义。
      Set oDoc = ActiveDocument
      Set oTable =oDoc.Tables.Add(Range:=oDoc.Range(Start:=0,End:=0),NumRows:=
    4,NumColumns:=4)
      iCount = 1
      For Each oCell In oTable.Range.Cells
      If iCount Mod 4 = 1 And iCount > 4 Then
        oCell.Range.InsertAfter Format(Date + (iCount - 1) / 4, "YYYY.MM.DD")
      End If
      If iCount Mod 4 = 2 And iCount > 4 Then
        oCell.Range.InsertAftercWeekName(WeekDay(Date+(iCount - 1) / 4))
      End If
      iCount = iCount + 1
       Next oCell
       oTable.AutoFormat Format:=wdTableFormatColorful1,ApplyBorders:=True, Ap
    plyFont:=True, ApplyColor:=True
    @@0869601.JPG;图2@@
      (2) 如果需要在表格的第二列插入星期值,可在上例的For Each...Next结构中插入以下几行:
      If iCount Mod 4 = 2 And iCount > 4 Then
      oCell.Range.InsertAfter cWeekName(WeekDay(Date + (iCount - 1) / 4))
      End If
      其中,WeekDay(Date)返回一数值(1~7),分别表示"星期日"~"星期六",CWeekName数组需要事先定义为:
      Dim cWeekName(7)
      cWeekName(1) = "星期日"
      cWeekName(2) = "星期一"
      ......
      cWeekName(7) ="星期六"
      4. 根据单元格的内容设置不同的格式
      以上例中表格为例,如果需要将所有"星期六"和"星期日"所在行格式改为蓝色背景,只要在上例程序之后追加以下几行即可(表格格式改为wdTableFormatColorful2,行数改为12行)。程序中再次使用For Each...Next结构遍历表格中的每一行(Rows),如果检测到某一行满足条件("星期六"或"星期日"),则选择一行(Selection.SelectRow),将其属性改为需要的格式(本例中为蓝色背景)。
      iCount = 1
      For Each Rows In oTable.Range.Rows
      If (WeekDay(Date + (iCount - 1)) = 7 Or WeekDay(Date + (iCount - 1))= 1)
    And iCount > 1
       Then
        Selection.SelectRow
        With Selection.Cells
      With .Shading
      .Texture = wdTextureNone
      .ForegroundPatternColorIndex = wdAuto
      .BackgroundPatternColorIndex = wdBlue
      End With
       End With
      End If
       iCount = iCount + 1
       Selection.MoveDown Unit:=wdLine, Count:=1
       Next Rows
    @@0869602.JPG;图3@@
      以上几例简要介绍了使用VBA自动处理Word表格的例子(有关Visual Basic事件、方法、对象、属性的详细使用方法请参阅Microsoft Word Visual Basic帮助)。客户可将编制的Visual Basic代码作为Word宏指定到工具栏或快捷方式,方便以后的使用。 
      

  3.   

    谢谢!顺便问问,在VB中能使用VBA的东东吗?
    有没有办法在Word中将获取某些位置的数据?比如,我先定义好了一个模板,里面已经有了些固定好的东西了,然后我需要对另外一些地方(如一张表格)进行数据的采集,写入,又应该如何做.最好能在VB环境中完成.
      再次谢谢高手.