水晶报表实现选择任意字段打印（VB）

在网上找了很多水晶报表选择字段打印的方法，都没有得到想要的结果！

虽说可以调用水晶报表的Report Wizard 功能强大，但客户用起来感觉头晕，

没办法，只好自己动手了~~~~



选择要打印的字段~~~



设置打印参数，如果要打印标题目的话输入打印标题。

选择添加序号列将在每条记录前面加上自增序号，效果图如下





报表还是要自己设计，不过报表里面不放任何字段



主要代码：

Private Sub Command3_Click()
Me.MousePointer = vbHourglass
Dim tbname As String '如果 TTX 文件名为 为 OA_GC,则 tbname 为 OA_GC_TTX,依此类推

tbname = "CRPTTX_TTX"
Set ReportTTX = New CRPTTX
If SetReport(tbname, ReportTTX) = False Then Exit Sub

STRtemp = "select "
For INTtemp = 1 To myCols.allCols.Count
STRtemp = STRtemp & myCols.allCols(INTtemp).fldName & ","
Next
STRtemp = STRtemp & myCols.showCols(myCols.showCols.Count).fldName & " from " & frmData.tableName '& " AS " & myCols.showCols(myCols.showCols.Count).colName
'设置相应的 Recordset 对象

If frmData.strGL <> "" Then
STRtemp = STRtemp & " where " & frmData.strGL
End If

STRtemp = STRtemp & frmData.strOrder

Set ADOtemp = New Recordset
ADOtemp.Open STRtemp, DB, adOpenStatic, adLockReadOnly
'这里必须提供 TTX 文件中所定义的所有字段的 记录集,否则显示会不正常
ReportTTX.Database.SetDataSource ADOtemp

frmPrintView.Show vbModal
Me.MousePointer = vbDefault
End Sub

'======http://blog.csdn.net/fage407/===设置报表===http://blog.csdn.net/fage407/=============
Private Function SetReport(tbname As String, ByRef myReport As Variant) As Boolean
On err GoTo SetReportError:
Dim objFld As FieldObject
Dim objLine As LineObject
Dim objTextbox As TextObject
'------------------------------设置打印参数--------------------------------
Dim paperSize As CRPaperSize '纸张类型,A4,A3,...
Dim paperStyle As CRPaperOrientation '纵向还是横向
Dim headerHeight As Long ' 表头行高
Dim detailHeight As Long ' 详细行高

Dim nextFldX As Long ' 下一个字段的 X 坐标值,初始为 0 ,如果字段所在坐标超出页面则显示不了但不会出错

Dim bAddXH As Boolean '是否添加序号列
Dim bAddPrintDate As Boolean '是否插入打印日期
Dim bAddPageNum As Boolean '是否插入页码
Dim bAutoWrap As Boolean '是否超出长度时自动换行
Dim bDrawGrid As Boolean '是否绘制表格

'-----------------纸张类型--------------------
If combo_paperSize.ListIndex = 0 Then
paperSize = crPaperA4
ElseIf combo_paperSize.ListIndex = 1 Then
paperSize = crPaperA3
ElseIf combo_paperSize.ListIndex = 2 Then
paperSize = crPaperA5
ElseIf combo_paperSize.ListIndex = 3 Then
paperSize = crPaperB4
ElseIf combo_paperSize.ListIndex = 4 Then
paperSize = crPaperB5
'ElseIf combo_paperSize.ListIndex = 5 Then '暂不支持自定义大小
'paperSize = crDefaultPaperSize
End If

'--------纵打还是横打----------
If Option1.Value = True Then
paperStyle = crPortrait '纵打,默认值
Else
paperStyle = crLandscape '横打
End If

'--------检测页边距---------
'如果失败则退出并释放资源
If CheckMargin = False Then
Set myReport = Nothing
SetReport = False
Exit Function
End If
'--------设置页面边距----------
'-------- 1厘米= 567 ---------
'----CDbl 将字符转换成 Double------
myReport.TopMargin = CDbl(tbox_Margin(0).Text) * 567
myReport.BottomMargin = CDbl(tbox_Margin(1).Text) * 567
myReport.LeftMargin = CDbl(tbox_Margin(2).Text) * 567
myReport.RightMargin = CDbl(tbox_Margin(3).Text) * 567

'-------------行高-----------
headerHeight = FlxGrid.RowHeight(0)
detailHeight = FlxGrid.RowHeight(1)

'----------其它设置----------
If chk_AddXH.Value = vbChecked Then bAddXH = True
If chk_AddPrintDate.Value = vbChecked Then bAddPrintDate = True
If chk_AddPageNum.Value = vbChecked Then bAddPageNum = True
If chk_AutoWrap.Value = vbChecked Then bAutoWrap = True
If chk_DrawGrid.Value = vbChecked Then bDrawGrid = True

'======================http://blog.csdn.net/fage407/==============================
myReport.paperSize = paperSize
myReport.PaperOrientation = paperStyle
myReport.ConvertDateTimeType = crKeepDateTimeType

'----------------添加 序号 ---------------------------
If bAddXH = True Then
Set objTextbox = myReport.Section3.AddTextObject("序号", 50, 50)
Set objFld = myReport.Section5.AddSpecialVarFieldObject(crSVTRecordNumber, 50, 50)
objTextbox.Width = FlxGrid.colWidth(1)
objFld.Width = FlxGrid.colWidth(1)

nextFldX = objTextbox.Width + 50
If bDrawGrid = True Then
Set objLine = myReport.Section3.AddLineObject(nextFldX, 0, nextFldX, 0, myReport.Section6)
End If

objFld.HorAlignment = crHorCenterAlign
objTextbox.HorAlignment = crHorCenterAlign
objTextbox.Height = headerHeight
objFld.Height = detailHeight
objTextbox.CanGrow = True
objFld.CanGrow = bAutoWrap
objTextbox.Font.Name = myFontName
objFld.Font.Name = myFontName
objTextbox.Font.Bold = bfontBold
objFld.Font.Bold = bfontBold
objTextbox.Font.Size = myFontSize
objFld.Font.Size = myFontSize
objTextbox.Font.Italic = bfontItalic
objFld.Font.Italic = bfontItalic
objTextbox.Font.Strikethrough = bfontStrikethrough
objFld.Font.Strikethrough = bfontStrikethrough
objTextbox.Font.Underline = bfontUnderline
objFld.Font.Underline = bfontUnderline

End If

'-----------------------------如果标题不空，则添加标题---------------------------
If Trim(tbox_title.Text) <> "" Then
Set objTextbox = myReport.Section2.AddTextObject(tbox_title.Text, 0, 0)
objTextbox.Width = myReport.Section2.Width
objTextbox.HorAlignment = crHorCenterAlign
objTextbox.CanGrow = True
objTextbox.Font.Name = tbox_title.Font.Name
objTextbox.Font.Size = tbox_title.Font.Size
objTextbox.Font.Bold = tbox_title.Font.Bold
objTextbox.Font.Italic = tbox_title.Font.Italic
objTextbox.Font.Strikethrough = tbox_title.Font.Strikethrough
objTextbox.Font.Underline = tbox_title.Font.Underline
End If
'------------------------------添加数据字段--------------------------------------
For INTtemp = 1 To myCols.showCols.Count

'添加列表头
nextFldX = nextFldX + 50 'cellpadding 50
Set objTextbox = myReport.Section3.AddTextObject(myCols.showCols.Item(INTtemp).colName, nextFldX, 50)
'添加字段
Set objFld = myReport.Section5.AddFieldObject("{" & tbname & "." & myCols.showCols.Item(INTtemp).fldName & "}", nextFldX, 50)

If bAddXH = False Then
nextFldX = nextFldX + FlxGrid.colWidth(INTtemp) + 50
Else
nextFldX = nextFldX + FlxGrid.colWidth(INTtemp + 1) + 50
End If

If bDrawGrid = True Then
Set objLine = myReport.Section3.AddLineObject(nextFldX, 0, nextFldX, 0, myReport.Section6)
End If

If bAddXH = False Then
objTextbox.Width = FlxGrid.colWidth(INTtemp)
objFld.Width = FlxGrid.colWidth(INTtemp)
Else
objTextbox.Width = FlxGrid.colWidth(INTtemp + 1)
objFld.Width = FlxGrid.colWidth(INTtemp + 1)
End If

objTextbox.HorAlignment = crHorCenterAlign

If myCols.showCols.Item(INTtemp).align = CenterCenter Or myCols.showCols.Item(INTtemp).align = CenterTop Then
objFld.HorAlignment = crHorCenterAlign
ElseIf myCols.showCols.Item(INTtemp).align = LeftCenter Or myCols.showCols.Item(INTtemp).align = LeftTop Then
objFld.HorAlignment = crLeftAlign
ElseIf myCols.showCols.Item(INTtemp).align = RightCenter Or myCols.showCols.Item(INTtemp).align = RightTop Then
objFld.HorAlignment = crRightAlign
End If

objTextbox.Height = headerHeight
objTextbox.CanGrow = True
objTextbox.Font.Name = myFontName
objTextbox.Font.Bold = bfontBold
objTextbox.Font.Size = myFontSize
objTextbox.Font.Italic = bfontItalic
objTextbox.Font.Strikethrough = bfontStrikethrough
objTextbox.Font.Underline = bfontUnderline

objFld.Height = detailHeight
objFld.CanGrow = bAutoWrap
objFld.Font.Name = myFontName
objFld.Font.Bold = bfontBold
objFld.Font.Size = myFontSize
objFld.Font.Italic = bfontItalic
objFld.Font.Strikethrough = bfontStrikethrough
objFld.Font.Underline = bfontUnderline

Next

If bDrawGrid = True Then

Set objLine = myReport.Section3.AddLineObject(0, 0, nextFldX, 0) '上边框
objLine.LineThickness = 30
Set objLine = myReport.Section4.AddLineObject(0, 0, nextFldX, 0) '列名下面的线
objLine.LineThickness = 30
Set objLine = myReport.Section3.AddLineObject(0, 0, 0, 0, myReport.Section6) '左边框
objLine.LineThickness = 30
Set objLine = myReport.Section3.AddLineObject(nextFldX, 0, nextFldX, 0, myReport.Section6) '右边框
objLine.LineThickness = 30
'Set objLine = myReport.Section4.AddLineObject(0, 0, nextFldX + 30, 0) '下边框
'objLine.LineThickness = 30

Set objLine = myReport.Section6.AddLineObject(0, 0, nextFldX, 0) 'detail 区分隔线
End If
SetReport = True
Exit Function
SetReportError:
MsgBox err.Description
SetReport = False
Exit Function
End Function