数组中的数据如何导出到指定的excel表，并实现打印？谢谢！

Question

我在ＶＢ中经常要计算一组数据，已将它们用二维数组存放，同时在excel中设计了一张固定表格，想把这些数据存放到表格指定的位置（比如某行某列），并能在ＶＢ中实现对此表格的打印设置和打印功能，请问各位楼主如何解决？
另外我也偿试用水晶报表实现，但发现在水晶报表里不能在一个方格里画任意角度的多条斜线，不知为何？如果可以画出来，那怎样将此数组放入水晶报表的指定位置呢？

Answer 1

Option Explicit
Public Sub ExporToExcel()
    
    '建立一个ADO数据连接
    Dim DataConn As New ADODB.Connection
    Dim DataRec As New ADODB.Recordset
    
    Dim strSQL As String
    
'若数据库连接出错，则转向ConnectionERR
On Error GoTo ConnectionERR
    
    '建立一个连接字串
    '这个连接串可能根据数据库配置的不同而不同
    DataConn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;"
    DataConn.ConnectionString = DataConn.ConnectionString & "Persist Security Info=False;"
    DataConn.ConnectionString = DataConn.ConnectionString & "Initial Catalog=pubs;"
    DataConn.ConnectionString = DataConn.ConnectionString & "Data Source=localhost"
    
    '建立数据库连接
    DataConn.Open
    
'若RecordSet建立出错，则转向RecordsetERR
On Error GoTo RecordSetERR
    
    strSQL = "SELECT au_lname,au_fname,phone,address,city "
    '从表authors查询
    strSQL = strSQL & "FROM authors"
    
    Dim lngRowCount As Integer
    Dim lngColCount As Integer
    
    
    Dim ExcelAppX As Excel.Application
    Dim ExcelBookX As Excel.Workbook
    Dim ExcelSheetX As Excel.Worksheet
    Dim ExcelQueryX As Excel.QueryTable
    
    With DataRec
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = DataConn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strSQL
        .Open
    End With
    With DataRec
        If .RecordCount < 1 Then
            Call MsgBox("没有记录!", vbExclamation, "错误")
            Exit Sub
        End If
        '记录总数
        lngRowCount = .RecordCount
        '字段总数
        lngColCount = .Fields.Count
    End WithOn Error GoTo ExcelERR
    '建立Excel应用程序
    Set ExcelAppX = CreateObject("Excel.Application")
    '建立WorkBook
    Set ExcelBookX = ExcelAppX.Workbooks().Add(App.Path & "\authors.xlt")
    '建立表格sheet1
    Set ExcelSheetX = ExcelBookX.Worksheets("sheet1")
    ExcelAppX.Visible = True
    
    '添加查询，填充Excel表格
    '注意此句！！！
    '从A3处向右下填充表格
    Set ExcelQueryX = ExcelSheetX.QueryTables.Add(DataRec, ExcelSheetX.Range("A3"))
    
    '查询设置
    With ExcelQueryX
        '是否显示字段名
        .FieldNames = False
        '是否显示行号
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        '后台搜索
        .BackgroundQuery = True
        '刷新样式
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        '是否保存数据
        .SaveData = True
        '是否自动调整列宽度
        .AdjustColumnWidth = False
        '自动刷新间距，设置为0是关闭自动刷新
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    '进行查询
    ExcelQueryX.Refresh
    
    '设置字体和表格属性
    With ExcelSheetX
        .Range(.Cells(1, 1), .Cells(lngRowCount + 2, lngColCount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    
    '设置打印信息
    With ExcelSheetX.PageSetup
        .LeftHeader = "&""楷体_GB2312,常规""&10公司名称："
        .CenterHeader = "&""楷体_GB2312,常规""&10日期："
        .RightHeader = "&""楷体_GB2312,常规""&10单位："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" & Date
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    ExcelAppX.Application.Visible = True
    ExcelSheetX.PrintPreview
    ExcelAppX.DisplayAlerts = False
    ExcelAppX.Quit
    Set ExcelAppX = Nothing  '"交还控制给Excel
    Set ExcelBookX = Nothing
    Set ExcelSheetX = Nothing    Exit SubConnectionERR:
    '错误处理程序
    MsgBox "数据库连接错误，" & Err.Description, vbCritical, "出错"
    Exit Sub
    
RecordSetERR:
    MsgBox "RecordSet生成错误，" & Err.Description, vbCritical, "出错"
    DataConn.Close
    Exit Sub
    
ExcelERR:
    MsgBox "填充Excel表格错误，" & Err.Description, vbCritical, "出错"
    If Not ExcelAppX Is Nothing Then ExcelAppX.Quit
    DataRec.Close
    DataConn.CloseEnd Sub
Private Sub Command1_Click()
    Call ExporToExcel
End Sub