-----=datagrid打印=-----
现做好了一个水晶报表、做好了远程连接物料基本资料表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相应报表数据的按纽代码咋写？ --------------------编程问答-------------------- 我有个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 Function
ConnectionERR:
'错误处理程序
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.Close
End Function --------------------编程问答-------------------- 还有下边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
补充：VB , 基础类
