-----=datagrid打印=-----

Question

现做好了一个水晶报表、做好了远程连接物料基本资料表
FORM1连接代码：
Set m_Connection = New ADODB.Connection
Set adoRS = New ADODB.Recordset
Set m_Report = New CrystalReport1
'If adoRS.State = adStateOpen Then adoRS.Close
m_Connection.ConnectionString = "Driver={sql server};server=192.168.0.1;uid=jean;pwd=jean;database=new"
m_Connection.ConnectionTimeout = 30
m_Connection.Open
m_Connection.CursorLocation = adUseClient
If adoRS.State = adStateOpen Then adoRS.Close
adoRS.Open "物料基本资料", m_Connection, adOpenKeyset, adLockReadOnly
m_Report.Database.SetDataSource adoRS, 3, 1 '此行取消
m_Report.Database.SetDataSource (adoRS)
m_Report.ReadRecords
CRViewer91.ReportSource = m_Report
CRViewer91.ViewReport生成了CrystalReport1和FORM1
目前有个查询窗体FORM2中的DATAGRID表已远程连接物料基本资料表
请问FORM2窗体中打印DATAGRID相应报表数据的按纽代码咋写？

Answer 1

我有个DATAGRID控件打印是导出到EXCEL后利用其打印的，代码如下：
Public Function ExporToExcel(ByVal strSQL As String, ByVal DataNames As String)
    
    '建立一个ADO数据连接
    
'若数据库连接出错，则转向ConnectionERR
On Error GoTo ConnectionERR
    
    '建立一个连接字串
    If OpenFiles = True Then
       MsgBox "数据库连接错误，" & err.Description, vbCritical, "出错"
    End If
    
'若RecordSet建立出错，则转向RecordsetERR
On Error GoTo RecordSetERR
    
    
    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
    
    Dim i As Integer
    
    '从表KCDA查询
   
     With DataRec
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = DataConn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strSQL
        .Open
    End With
    lngRowCount = 0
     Do While (Not DataRec.EOF)
      lngRowCount = lngRowCount + 1 '记录总数
      DataRec.MoveNext
    Loop
    With DataRec
'        If .RecordCount < 1 Then
'            Call MsgBox("没有记录!", vbExclamation, "错误")
'            Exit Function
'        End If
'        '记录总数
'        lngRowCount = .RecordCount
        '字段总数
        lngColCount = .Fields.Count
    End With
   
On Error GoTo ExcelERR
    '建立Excel应用程序
    Set ExcelAppX = CreateObject("Excel.Application")
    '建立WorkBook
    Set ExcelBookX = ExcelAppX.Workbooks().Add(App.Path & "\data\Authors.xlt")
    '建立表格sheet1
    Set ExcelSheetX = ExcelBookX.Worksheets("sheet1")
'    ExcelAppX.Visible = True
    
    '根据表头字段数设置表格列宽
     For i = 0 To DataRec.Fields.Count - 1
      If Len(DataRec.Fields(i).Name) > 4 Then
          ExcelAppX.Range(ConvertXY2Cell(i + 1, i + 1)).Select
          ExcelAppX.ActiveCell.Cells.ColumnWidth = Len(DataRec.Fields(i).Name) * 2 + 1
       Else
          ExcelAppX.Range(ConvertXY2Cell(i + 1, i + 1)).Select
          ExcelAppX.ActiveCell.Cells.ColumnWidth = 5 * 2 + 1
       End If
    Next i
    
    '添加查询，填充Excel表格
    '注意此句！！！
    ExcelAppX.Range(ConvertXY2Cell(1, 1)).Select
    '加粗
    ExcelAppX.ActiveCell.Font.Bold = True
    ExcelAppX.ActiveCell.Font.Size = 20
'    ExcelAppX.ActiveCell.Cells.ColumnWidth = ExcelAppX.ActiveCell.Range(1, 1).Width
    '填写表头
    ExcelAppX.ActiveCell.Value = DataNames
    
    '从A3处向右下填充表格
    
    Set ExcelQueryX = ExcelSheetX.QueryTables.Add(DataRec, ExcelSheetX.Range("A2"))
    
    '查询设置
    With ExcelQueryX
        '是否显示字段名
        .FieldNames = True
        '是否显示行号
        .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日期：" + CStr(Date)
'        .RightHeader = "&""楷体_GB2312,常规""&10单位："
'        .RightHeader = "&""楷体_GB2312,常规""&10日期：" + CStr(Date)
        .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
    DataRec.Close
    DataConn.Close
    Exit FunctionConnectionERR:
    '错误处理程序
    MsgBox "数据库连接错误，" & err.Description, vbCritical, "出错"
    Exit Function
    
RecordSetERR:
    MsgBox "RecordSet生成错误，" & err.Description, vbCritical, "出错"
    DataConn.Close
    Exit Function
    
ExcelERR:
    MsgBox "填充Excel表格错误，" & err.Description, vbCritical, "出错"
    If Not ExcelAppX Is Nothing Then ExcelAppX.Quit
    DataRec.Close
    DataConn.CloseEnd Function

Answer 2

还有下边2个函数Private Function ConvertXY2Cell(ByVal lngColumnCount As Long, ByVal lngRowCount) As String
    '本函数将行列数转换为Excel标示单元格的方式，如第一行第一列为A1
On Error GoTo errOut
    ConvertXY2Cell = ConvertColumnName(lngColumnCount) & CStr(lngRowCount)
errOut:
End Function
Private Function ConvertColumnName(lngColumnCount As Long) As String
    '本函数将列数转换为Excel标示列的字母，如列1在Excel为列A
    Dim Number1 As Long
    Dim Number2 As Long
    Dim tmpString As String
On Error GoTo errOut
    '计算第一个字母
    Number1 = Int(lngColumnCount / 26)
    '计算第二个字母
    Number2 = lngColumnCount Mod 26
    
    '判断列是否可以用一个字母表示
    If Number1 > 0 Then
        tmpString = Chr(Number1 + 64) & Chr(Number2 + 64)
    Else
        tmpString = Chr(Number2 + 64)
    End If
    
    ConvertColumnName = tmpString
errOut:
End Function