Foxtable(狐表) → 用户栏目 → 专家坐堂 → 专业表格，设置乡下合并行，如何自动调整行高


  共有2251人关注过本帖树形打印复制链接

主题：专业表格，设置乡下合并行，如何自动调整行高
帅哥哟，离线，有人找我吗？
xluoping
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：小狐 帖子：355 积分：3617 威望：0 精华：0 注册：2016/4/2 12:11:00 		专业表格，设置乡下合并行，如何自动调整行高  发帖心情 Post By：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
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107135 积分：544918 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2017/4/26 10:37:00 [只看该作者]

试试：http://www.foxtable.com/webhelp/scr/1201.htm

不是很明白你的问题，代码不完整，测试不了
 回到顶部
帅哥哟，离线，有人找我吗？
有点色
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：13837 积分：69650 威望：0 精华：0 注册：2016/11/1 14:42:00 		  发帖心情 Post By：2017/4/26 10:41:00 [只看该作者]

 只要你设置了列宽而不设置行高，自动的，就会按照自动行高来显示的。

 

 具体问题，请单独做个实例发上来。
 回到顶部
帅哥哟，离线，有人找我吗？
xluoping
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：小狐 帖子：355 积分：3617 威望：0 精华：0 注册：2016/4/2 12:11:00 		  发帖心情 Post By：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()
 回到顶部
帅哥哟，离线，有人找我吗？
有点色
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：13837 积分：69650 威望：0 精华：0 注册：2016/11/1 14:42:00 		  发帖心情 Post By：2017/4/26 12:13:00 [只看该作者]

 把这句代码删除

 

rt.Cells(r + 1, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy '换页后重复单元格

 
 回到顶部
帅哥哟，离线，有人找我吗？
xluoping
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：小狐 帖子：355 积分：3617 威望：0 精华：0 注册：2016/4/2 12:11:00 		  发帖心情 Post By：2017/4/27 17:33:00 [只看该作者]

这句代码删除的话，下一页的就不能重复显示上一页合并的单元格的数据了图片点击可在新窗口打开查看

 

rt.Cells(r + 1, c).VertSplitBehavior = prt.CellSplitBehaviorEnum.Copy '换页后重复单元格
 回到顶部
帅哥哟，离线，有人找我吗？
有点色
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：13837 积分：69650 威望：0 精华：0 注册：2016/11/1 14:42:00 		  发帖心情 Post By：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

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.04883 秒, 4 次数据查询