专家坐堂-专业报表合并合并单元格后数据显示不全Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

老师，我用专业报表，按咱们教程上的例子合并单元格，但是合并列如果一行字符较多时，也会换行显示，但是行高确是一行的，显示不全，如果对该列不合并，就会显示全了（如下图），请问如何解决

我的代码

\'数据单招计划

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

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

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

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

doc.SavePDF(fl)

Dim Proc As New Process \'打开PDF文件

Proc.File = fl

Proc.Start()