'数据单招计划
Dim tlr As Color = Color.FromARGB(255, 68, 114, 196) '头颜色
Dim ssr As Color = Color.FromARGB(255, 207, 213, 234) '深颜色
Dim qsr As Color = Color.FromARGB(255, 233, 235, 245) '浅颜色
'页面设置
Dim doc As New PrintDoc '定义一个报表
Doc.PageSetting.LeftMargin = 10 '设置左边距
Doc.PageSetting.RightMargin = 10 '设置右边距
Doc.PageSetting.TopMargin = 15 '设置上边距
Doc.PageSetting.BottomMargin = 10 '设置下边距
doc.PageSetting.Landscape = True '横向打印
Dim xxmc As String = "沧州职业技术学院"
Dim fl As String = "c:\data\school\单招-" & xxmc & ".pdf"
If 1 = 1 Then
Dim tb As Table = Tables("数据_单招计划")
tb.Filter = "([学校名称] Like '" & xxmc & "%') And ([年份] = '2024')"
'标题
If 1 = 1 Then
Dim rs As New prt.RenderText() '定义一个文本对象
rs.Style.Spacing.Top = 4 '表格和前面对象的垂直间隔为4毫米
rs.Style.Spacing.Bottom = 2 '表和和后续对象的垂直间隔为10毫米
rs.Text = "2024年" & xxmc & "在各类中招生录取情况表" '设置文本对象的内容
rs.Style.Font = New Font("方正黑体简体", 16) '设置字体
rs.Style.TextAlignHorz = prt.AlignHorzEnum.Center '文本内容水平居中
doc.Body.Children.Add(rs) '将文本对象加入到表格中
End If
If 1 = 1 Then
Dim rt As New prt.RenderTable '定义一个新表格
Dim MergeCols As New List(Of String) From {"科类", "学校名称", "投档分", "排序及位置"} '要进行合并的列名，尽量放最前面
tb.Sort = "代码,投档分 desc,学校代号,专业代号"
Dim ColNames As New List(Of String) From {"科类", "学校名称", "投档分", "排序及位置", "专业名称", "计划", "学费"}
rt.RepeatGridLinesVert = True '换页后重复表格线
Dim hd As Integer = tb.HeaderRows '获得表头的层数
rt.Style.Font = New Font("方正仿宋简体", 12) '设置字体
' tb.CreateReportHeader(rt, True) '生成表头,排除隐藏列
For c As Integer = 0 To ColNames.count - 1
'自己写列标题
If ColNames(c) = "专业名称" Then
rt.Cells(0, c).Text = "专业名称及说明" '列名作为标题
Else
rt.Cells(0, c).Text = ColNames(c) '列名作为标题
End If
rt.Cells(0, c).Style.TextAlignHorz = prt.AlignHorzEnum.Center '标题内容水平居中
If tb.Cols(ColNames(c)).IsNumeric OrElse tb.Cols(ColNames(c)).IsDate Then
rt.Cols(c).Style.TextAlignHorz = prt.AlignHorzEnum.Center
End If
Dim lr As Integer ' 用于保存合并区域的起始行
For r As Integer = 0 To tb.Rows.Count - 1
'隔行变色
If r Mod 2 = 0 Then
rt.Cells(r + hd, c).Style.BackColor = ssr
Else
rt.Cells(r + hd, c).Style.BackColor = qsr
End If
If MergeCols.Contains(ColNames(c)) Then '如果是要合并的列
Dim Merge As Boolean = True
If r < hd Then
Merge = False
Else
For n As Integer = 0 To c
If tb.Rows(r)(ColNames(n)) <> tb.Rows(r - 1)(ColNames(n)) Then
Merge = False
Exit For
End If
Next
End If
If Merge Then
rt.Cells(lr, c).SpanRows = rt.Cells(lr, c).SpanRows + hd
Else
rt.Cells(r + hd, c).Text = tb.Rows(r)(ColNames(c))
If ColNames(c).Contains("科类") Then
If tb.Rows(r)("对象").ToString.Contains("退") Then
rt.Cells(r + hd, c).Text = tb.Rows(r)(ColNames(c)) & "(退役士兵)"
End If
End If
rt.Cells(r + hd, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy '换页后重复单元格
lr = r + 1
End If
Else
If tb.Cols(c).IsNumeric AndAlso tb.Rows(r).IsNull(ColNames(c)) Then
rt.Cells(r + hd, c).Text = ""
ElseIf ColNames(c).Contains("专业名称") Then
rt.Cells(r + hd, c).Text = tb.Rows(r)(ColNames(c)) & tb.Rows(r)("专业简注")
ElseIf ColNames(c).Contains("科类") Then
If tb.Rows(r)("对象").ToString.Contains("退") Then
rt.Cells(r + hd, c).Text = tb.Rows(r)(ColNames(c)) & "(退役士兵)"
Else
rt.Cells(r + hd, c).Text = tb.Rows(r)(ColNames(c))
End If
Else
rt.Cells(r + hd, c).Text = tb.Rows(r)(ColNames(c))
End If
End If
Next
Next
rt.Cols(0).Width = 40
rt.Cols(1).Width = 80
rt.Cols(2).Width = 20
rt.Cols(3).Width = 20
rt.Cols(4).Width = 100
rt.Cols(5).Width = 20
rt.Cols(6).Width = 20
'rt.Style.TextAlignHorz = prt.AlignHorzEnum.Center '水平居中
rt.Style.TextAlignVert = prt.AlignHorzEnum.Center '垂直居中
rt.Style.Gridlines.All = New prt.Linedef(Color.white)
rt.CellStyle.Spacing.All = 0.8
'以下是对表头的设置
rt.RowGroups(0, tb.HeaderRows).Style.BackColor = tlr
rt.RowGroups(0, tb.HeaderRows).Style.TextColor = Color.white
rt.RowGroups(0, tb.HeaderRows).Style.Font = New Font("方正黑体简体", 12) '设置字体
rt.RowGroups(0, tb.HeaderRows).Header = prt.TableHeaderEnum.All '利用行组功能设置表头
rt.RowGroups(0, tb.HeaderRows).CellStyle.Spacing.All = 1.2
doc.Body.Children.Add(rt) '将表格加入到报表
End If
'定义一个页脚
If 1 = 1 Then
Dim rs As New prt.RenderText() '定义一个文本对象
rs.Style.Spacing.Top = 2 '表格和前面对象的垂直间隔为4毫米
rs.Text = "说明：投档分为该学校代号下所有专业的最低分,并非具体专业的分数；排序及位置比如是36/60,表示该类共有60所学校，该校投档分由高到低排36名，可以反映该校在全部学校中的位置。"
rs.Style.Font = New Font("方正楷体简体", 10) '设置文本对象的字体
doc.Body.Children.Add(rs) '将文本对象加入到表格中
End If
End If
doc.SavePDF(fl)
Dim Proc As New Process '打开PDF文件
Proc.File = fl
Proc.Start()
加好友 
发短信
Post By：2025/3/2 10:08:00 [显示全部帖子]
此主题相关图片如下：1.png
