- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 专业表格，设置乡下合并行，如何自动调整行高 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=99746)
-- 发布时间：2017/4/26 9:55:00
-- 专业表格，设置乡下合并行，如何自动调整行高
专业表格，设置向下合并行（前3列），如何自动调整行高？如下代码，第1列有同类项合并，第2列 岗位 列 的文本有很多，但没有同类项，这时 第2列的数据只有一行表格，有很多文字不能显示，如何才能自动调整行高，全部显示呢？
doc = New PrintDoc \'定义一个报表
doc.PageSetting.PaperKind = 9 \'纸张类型
doc.PageSetting.Landscape = True \'横向打印
Doc.PageSetting.LeftMargin = 10 \'设置左边距
Doc.PageSetting.RightMargin = 10 \'设置右边距
Doc.PageSetting.TopMargin = 10 \'设置上边距
Doc.PageSetting.BottomMargin = 10 \'设置下边距
Dim rtt As new prt.RenderText \'定义一个文本对象
\'设置页眉
rtt.Text = jg & " T-ETS-621" \'设置文本内容
rtt.Style.TextAlignHorz = prt.AlignHorzEnum.Right \'靠右对齐
rtt.Style.Padding.Bottom = 0.5 \'底端内容缩进0.5毫米
rtt.Style.FontSize = 10 \'字体大小为8磅
Doc.PageHeader = rtt \'作为页眉使用
rt.RowGroups(0,4).Header = prt.TableHeaderEnum.All \'将第一行作为表头.
rt.RepeatGridLinesVert = True
rt.Cols.Count = 14 \'设置总列数
rt.Cols(0).Width = 26 \'设置前四列的宽度,剩余的宽度被分配给5列(显示图片的那列)
rt.Cols(1).Width = 24
rt.Cols(2).Width = 24
rt.Cols(3).Width = 25
rt.Cols(4).Width = 10
rt.Cols(5).Width = 15
rt.Cols(6).Width = 20
rt.Cols(7).Width = 16
rt.Cols(8).Width = 15
rt.Cols(9).Width = 15
rt.Cols(10).Width = 19
rt.Cols(11).Width = 18
rt.Cols(12).Width = 15
rt.Cols(13).Width = 10
rt.CellStyle.Spacing.All = 1 \'单元格内容缩进1毫米
rt.Style.GridLines.All = New prt.Linedef \'设置网格线
rt.Style.TextAlignVert = prt.AlignVertEnum.Center \'内容垂直居中
rt.Style.TextAlignHorz = prt.AlignVertEnum.Center \'内容平行居中
rt.Style.FontSize = 12
\'设置主标题
rt.Cells(0,0).text = Chr(13) & Chr(10) & "现场采样和检测计划"
rt.Cells(0,0).SpanCols = 14 \'合并第一行全部单元格,用于显示主标题
rt.Cells(0,0).Style.TextAlignHorz = prt.AlignHorzEnum.Center \'主标题居中
rt.Cells(0,0).Style.Font = New Font("仿宋", 18, FontStyle.Bold) \'设置主标题字体
rt.Rows(0).Style.Borders.All = New prt.LineDef("0mm", Color.white) \'去掉第一行的网格线
\'设置副标题
rt.Cells(1,0).text = "修订号:003 第[PageNo]页/共[PageCount]页" \'通过左边空格数量来调整副标题位置
rt.Cells(1,0).SpanCols = 14 \'合并地二行全部单元格,用于显示副标题
rt.Cells(1,0).Style.TextAlignHorz = prt.AlignHorzEnum.right \'副标题内容居左
rt.Rows(1).Style.Borders.All = New prt.LineDef("0mm", Color.white) \'去掉第二行的网格线
rt.Rows(1).Style.Borders.Bottom = New prt.Linedef \'恢复第二行底端的网格线
rt.Cells(2,0).text = "用人单位:" & dr("客户名称") & " 计划采样日期:" & sti & Chr(13) & Chr(10) & "检测类别:" & dr("项目类别") & " 委托序号:" & st1 & " 检测任务编号:" & cmb0 \'通过左边空格数量来调整副标题位置
rt.Cells(2,0).SpanCols = 14 \'合并地二行全部单元格,用于显示副标题"
rt.Cells(2,0).Style.TextAlignHorz = prt.AlignHorzEnum.left \'副标题内容居中
rt.Rows(2).Style.Borders.All = New prt.LineDef("0mm", Color.white) \'去掉第二行的网格线
rt.Rows(2).Style.Borders.Bottom = New prt.Linedef \'恢复第二行底端的网格线
\'rt.Rows(2).Height = 18 \'设置第二行的高度,拉开和表格主体的距离.
\'设置列标题
rt.Cells(3,0).Text = "车间/工作场所名称"
rt.Cells(3,1).Text = "岗位(工种)"
rt.Cells(3,2).Text = "采样点/对象"
rt.Cells(3,3).Text = "检测项目"
rt.Cells(3,4).Text = "样品数量"
rt.Cells(3,5).Text = "采样方式"
rt.Cells(3,6).Text = "采样时机/时段"
rt.Cells(3,7).Text = "采样流量" & Chr(13) & Chr(10) & "(L/min)"
rt.Cells(3,8).Text = "空气收集器"
rt.Cells(3,9).Text = "采样设备"
rt.Cells(3,10).Text = "样品保存期限和保存条件"
rt.Cells(3,11).Text = "样品编号"
rt.Cells(3,12).Text = "测点编号"
rt.Cells(3,13).Text = "备注"
i = 3
Dim str3 As String
Dim str4 As String
Dim str5 As String
Dim lr As Integer
Dim lr2 As Integer
Dim lr1 As Integer
For Each dr1 In DataTables("样品登记").Select("[客户名称] = \'" & st0 & "\' and [任务编号] = \'" & st1 & "\' and [任务序号] = \'" & cmb0 & "\'" & daaaa,"空白,采样点排序,采样点序号,样品序号,项目名称,采样方式,创建日期")
If dr1("空白") = True Then
str4 = "空白" & dr1("采样点序号")
Else
str4 = Format(dr1("采样点序号"),"000")
End If
If str4 = str3 AndAlso i > 3 AndAlso str5 = dr1("车间名称") & dr1("采样设备") & dr1("空气收集器") & dr1("岗位") & dr1("采样点") & dr1("采样方式") Then
If rt.Cells(i,3).Text.Contains(dr1("项目名称") & ";") Then
If rt.Cells(i,11).Text.EndsWith(dr1("样品序号")) = False Then
rt.Cells(i,4).Text = CInt(rt.Cells(i,4).Text) + CInt(dr1("样品数量"))
If dr1.IsNull("样品序号") Then
rt.Cells(i,11).Text = "/"
Else
rt.Cells(i,11).Text = rt.Cells(i,11).Text & vbcrlf & str4 & "-" & dr1("样品序号")
End If
End If
Else
rt.Cells(i,3).Text = rt.Cells(i,3).Text & ";" & dr1("项目名称") & ";"
rt.Cells(i,3).Text = rt.Cells(i,3).Text.Replace(";;",";")
End If
Else
Dim c As Integer = 0
Dim Merge As Boolean = True
If i = 3 Then
Merge = False
Else
For n As Integer = 0 To c
If rt.Cells(i,n).Text <> rt.Cells(i-1,n).Text Then
Merge = False
Exit For
End If
Next
End If
If Merge Then
rt.Cells(lr,c).SpanRows = rt.Cells(lr,c).SpanRows + 1
Else
\' rt.Cells(i + 1, c).Text = rt.Cells(i, c).Text
rt.Cells(i, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
lr = i
End If
c = 1
Merge = True
If i = 3 Then
Merge = False
Else
For n As Integer = 0 To c
If rt.Cells(i,n).Text <> rt.Cells(i-1,n).Text Then
Merge = False
Exit For
End If
Next
End If
If Merge Then
rt.Cells(lr1,c).SpanRows = rt.Cells(lr1,c).SpanRows + 1
Else
\' rt.Cells(i + 1, c).Text = rt.Cells(i, c).Text
rt.Cells(i, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
lr1 = i
End If
c = 2
Merge = True
If i = 3 Then
Merge = False
Else
For n As Integer = 0 To c
If rt.Cells(i,n).Text <> rt.Cells(i-1,n).Text Then
Merge = False
Exit For
End If
Next
End If
If Merge Then
rt.Cells(lr2,c).SpanRows = rt.Cells(lr2,c).SpanRows + 1
Else
\' rt.Cells(i + 1, c).Text = rt.Cells(i, c).Text
rt.Cells(i, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
lr2 = i
End If
i = i + 1
rt.Cells(i,0).Text = dr1("车间名称")
rt.Cells(i,1).Text = dr1("岗位")
rt.Cells(i,2).Text = dr1("采样点")
rt.Cells(i,3).Text = dr1("项目名称") & ";"
If dr1.IsNull("样品数量") Then
rt.Cells(i,4).Text = ""
Else
rt.Cells(i,4).Text = dr1("样品数量")
End If
If dr1.IsNull("采样方式") Then
rt.Cells(i,5).Text = "/"
Else
rt.Cells(i,5).Text = dr1("采样方式")
End If
If dr1.IsNull("采样时机") Then
rt.Cells(i,6).Text = "/"
Else
rt.Cells(i,6).Text = dr1("采样时机")
End If
If dr1.IsNull("采样流量") Then
rt.Cells(i,7).Text = "/"
Else
rt.Cells(i,7).Text = dr1("采样流量")
End If
If dr1.IsNull("空气收集器") Then
rt.Cells(i,8).Text = "/"
Else
rt.Cells(i,8).Text = dr1("空气收集器")
End If
If dr1.IsNull("采样设备") Then
rt.Cells(i,9).Text = "/"
Else
rt.Cells(i,9).Text = dr1("采样设备")
End If
If dr1.IsNull("样品保存期限和保存条件") Then
rt.Cells(i,10).Text = "/"
Else
rt.Cells(i,10).Text = dr1("样品保存期限和保存条件")
End If
If dr1.IsNull("样品序号") Then
rt.Cells(i,11).Text = "/"
Else
rt.Cells(i,11).Text = str4 & "-" & dr1("样品序号")
End If
If dr1.IsNull("测点编号") Then
rt.Cells(i,12).Text = "/"
Else
rt.Cells(i,12).Text = "▲" & dr1("测点编号") & "#"
End If
rt.Cells(i,13).Text = dr1("备注")
End If
str3 = str4
str5 = dr1("车间名称") & dr1("采样设备") & dr1("空气收集器") & dr1("岗位") & dr1("采样点") & dr1("采样方式")
Next
-- 发布时间：2017/4/26 10:37:00
--
试试：http://www.foxtable.com/webhelp/scr/1201.htm
不是很明白你的问题，代码不完整，测试不了
-- 发布时间：2017/4/26 10:41:00
--
只要你设置了列宽而不设置行高，自动的，就会按照自动行高来显示的。
具体问题，请单独做个实例发上来。
-- 发布时间：2017/4/26 11:55:00
--
例如这段带代码： 当 某个 岗位 只有一条记录，而 岗位 的文本 有20个字符，那么，这一行的岗位是不能完全显示，行高只有一行文本的高度
Dim doc As New PrintDoc
Dim rt As New prt.RenderTable
Dim tb As Table = Tables("样品登记")
tb.DataTable.LoadFilter = "[_Identify] is not null"
tb.DataTable.LoadTop = 1000
tb.DataTable.Load
Dim ColNames As String() = New String(){"任务编号", "采样点","岗位","分析部组别","样品数量"}
Dim MergeCols As Integer = 3 \'指定要合并的列数
tb.Sort = "任务编号,采样点,岗位" \'根据合并列排序
\'rt.Width = "100%"
rt.SplitHorzBehavior = prt.SplitBehaviorEnum.SplitIfNeeded
rt.Style.Font = tb.Font
rt.Style.TextAlignVert = prt.AlignVertEnum.Center
rt.RepeatGridLinesVert = True \'换页后重复表格线
For c As Integer = 0 To ColNames.Length - 1
Dim lr As Integer \' 用于保存合并区域的起始行
rt.Cells(0,c).Text = ColNames(c)
rt.Cells(0,c).Style.TextAlignHorz = prt.AlignHorzEnum.Center
rt.Cols(c).Width = tb.Cols(ColNames(c)).PrintWidth
If tb.Cols(ColNames(c)).IsNumeric OrElse tb.Cols(ColNames(c)).IsDate Then
rt.Cols(c).Style.TextAlignHorz = prt.AlignHorzEnum.Right
End If
For r As Integer = 0 To tb.Rows.Count - 1
If c <= MergeCols - 1 Then \'如果是要合并的列
Dim Merge As Boolean = True
If r = 0 Then
Merge = False
Else
For n As Integer = 0 To c
If tb.Rows(r)(ColNames(n)) <> tb.Rows(r - 1)(ColNames(n))
Merge = False
Exit For
End If
Next
End If
If Merge Then
rt.Cells(lr,c).SpanRows = rt.Cells(lr,c).SpanRows + 1
Else
rt.Cells(r + 1, c).Text = tb.Rows(r)(ColNames(c))
rt.Cells(r + 1, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
lr = r + 1
End If
Else
rt.Cells(r + 1, c).Text = tb.Rows(r)(ColNames(c))
End If
Next
Next
rt.Cols(0).Width = 10
rt.Cols(1).Width = 10
rt.Cols(2).Width = 10
rt.Cols(3).Width = 50
rt.Cols(4).Width = 30
rt.Style.Gridlines.All = New prt.Linedef(Color.Gray)
rt.CellStyle.Spacing.All = 0.5
rt.Rows(0).Style.TextAlignHorz = prt.AlignHorzEnum.Center
rt.RowGroups(0,1).Header = prt.TableHeaderEnum.All
doc.Body.Children.Add(rt)
doc.Preview()
-- 发布时间：2017/4/26 12:13:00
--
把这句代码删除
rt.Cells(r + 1, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
-- 发布时间：2017/4/27 17:33:00
--
这句代码删除的话，下一页的就不能重复显示上一页合并的单元格的数据了
rt.Cells(r + 1, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
-- 发布时间：2017/4/27 17:45:00
--
If Merge Then
rt.Cells(lr,c).SpanRows = rt.Cells(lr,c).SpanRows + 1
rt.Cells(lr, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy \'换页后重复单元格
Else
rt.Cells(r + 1, c).Text = tb.Rows(r)(ColNames(c))
lr = r + 1
End If