With Tables("乙方情况汇总表_Table1")
Dim r As Integer
r = .FindRow("[分配金额] > 0") '从第一行开始查找
If r >= 0 Then '如果找到的话
Dim TotalArea As Decimal '合计总面积
Dim TotalPrice As Decimal '合计总价格
Dim FilalOutPutValue As Decimal '合计最终产值
Dim ShoudPay As Decimal '合计应付
Dim HaveToPay As Decimal '合计已付
Dim NonPayment As Decimal '合计未付
Dim Distribution As Decimal '合计分配
Dim Repeat As Integer
Repeat=0
Dim doc As New PrintDoc '定义一个报表
Doc.PageSetting.PaperKind = 0 '设定为自定义
Doc.PageSetting.Width=250
Doc.PageSetting.Height=120
Doc.PageSetting.Landscape = True '设置A4横向
Doc.PageSetting.LeftMargin = 5 '设置左边距
Doc.PageSetting.RightMargin = 5 '设置右边距
Doc.PageSetting.TOPMargin =5 '设置上边距
Doc.PageSetting.BottomMargin = 2 '设置下边距
Doc.AutoRotate = True '禁止自动旋转打印内容 注意:奇怪的现象,必须设置能自动旋转打印内容,不预览直接打印时才能横向打印.
Dim rt As New prt.RenderTable() '定义一个表格对象
Dim CurrentRow As Integer '日期可调整当前行
Dim SumRow As Integer '分配资金不为空的总行数
SumRow=0
CurrentRow=Tables("日期可调资金计划表").Position
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''表头的设计,格式设置为页眉形式,方便换行后自动添加表头
'''''对表头的字段单元格进行规范化,这样可以和下面代码中的表体和页脚对齐
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim rtFooter As New prt.RenderTable()'定义一个表格对象作为页脚
Dim rh As New prt.RenderTable() '定义一个表格对象作为页眉
rh.X = 2 '表格左部位置
rh.Y=2 '表格上部位置
rh.Width=247 '设置表格'=rh
doc.Body.Children.Add(rt) '将表格对象加入到报表中
rt.Style.GridLines.All = New prt.Linedef '设置网格线
rt.Style.TextAlignHorz = prt.AlignHorzEnum.Center '所有文本内容水平居中对齐
rt.Style.TextAlignVert = prt.AlignHorzEnum.Center '所有文本内容垂直居中对齐
rt.Style.Font = New Font("宋体", 13,FontStyle.Bold) ' FontStyle.Regular) '设置字体
rt.CellStyle.Spacing.All = 0 '内容距离网格线1毫米
'设置主标题
rh.Cells(0,0).text = "主体工程进度付款情况表"
rh.Cells(0,0).SpanCols = 14 '合并第一行全部单元格,用于显示主标题
rh.Cells(0,0).Style.TextAlignHorz = prt.AlignHorzEnum.Center '主标题居中
rh.Cells(0,0).Style.Font = New Font("宋体", 18, FontStyle.Bold) '设置主标题字体
rh.Rows(0).Style.Borders.All = New prt.LineDef("0mm", Color.white) '去掉第一行的网格线
'设置副标题
rh.Cells(1,0).text = Chr(9)& Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)&Format(Date.Today,"yyyy") & " 年 " & Format(Date.Today,"MM") & " 月 " & Format(Date.Today,"dd") & " 日 " '"2014年7月22日" '通过左边空格数量来调整副标题位置
rh.Cells(1,0).Style.Font = New Font("宋体", 12, FontStyle.Regular)
rh.Cells(1,0).SpanCols = 9 '合并第二行全部单元格,用于显示副标题
rh.Cells(1,0).Style.TextAlignHorz = prt.AlignHorzEnum.Center '副标题内容居中
rh.Rows(1).Style.Borders.All = New prt.LineDef("0mm", Color.white) '去掉第二行的网格线
rh.Rows(1).Height = 8 '设置第二行的高度,拉开和表格主体的距离.
rh.Cells(1,10).text = "单位(万元,万㎡)" & Chr(9)
rh.Cells(1,10).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.Cells(1,10).SpanCols = 4 '合并第二行全部单元格,用于显示副标题
rh.Cells(1,10).Style.TextAlignHorz = prt.AlignHorzEnum.Right '副标题内容居中
rh.Rows(1).Style.Borders.All = New prt.LineDef("0mm", Color.white) '去掉第二行的网格线
rh.Rows(1).Height = 8 '设置第二行的高度,拉开和表格主体的距离.
'设置列标题
'统一设定页眉,页脚与主体列宽,保证对齐
rt.Cols(0).width=10
rh.Cols(0).width=10
rtFooter.Cols(0).width=10
For m As Integer =1 To 13
rt.Cols(m).width=15
rh.Cols(m).width=15
rtFooter.Cols(m).width=15
If m=3 Then
rt.Cols(m).width=20
rh.Cols(m).width=20
rtFooter.Cols(m).width=20
End If
Next
rh.Rows(2).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,0).Text = "序号" '设置横向表头内容以及字体
rh.cells(2,0).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,0).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,0).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.Cells(2,0).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,1).Text = "乙方123456789"
rh.Cells(2,1).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,1).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,1).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,1).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,2).Text = "开发产品"
rh.Cells(2,2).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,2).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,2).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,2).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,3).Text = "所属楼栋"
rh.Cells(2,3).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,3).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,3).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,3).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,4).Text = "实际总面积"
rh.Cells(2,4).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,4).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,4).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,4).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,5).Text = "实际总价"
rh.Cells(2,5).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,5).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,5).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,5).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,6).Text = "预付产值最终实际产值累计"
rh.Cells(2,6).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,6).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,6).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,6).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,7).Text = "合同约定付款比例"
rh.Cells(2,7).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,7).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,7).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,7).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,8).Text = "应付进度款合计"
rh.Cells(2,8).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,8).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,8).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,8).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,9).Text = "已付进度款合计"
rh.Cells(2,9).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,9).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,9).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,9).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,10).Text = "欠款金额"
rh.Cells(2,10).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,10).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,10).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,10).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,11).Text = "当前付款比例"
rh.Cells(2,11).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,11).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,11).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,11).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,12).Text = "分配金额"
rh.Cells(2,12).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,12).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,12).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,12).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
rh.cells(2,13).Text = "分配后比例"
rh.Cells(2,13).Style.Font = New Font("宋体", 10, FontStyle.Regular)
rh.cells(2,13).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rh.cells(2,13).Style.TextAlignVert=prt.AlignVertEnum.Center
rh.Cells(2,13).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
' rh.cells(2,14).Text = "备注"
' rh.Cells(2,14).Style.Font = New Font("宋体", 10, FontStyle.Regular)
' rh.cells(2,14).Style.TextAlignHorz=prt.AlignHorzEnum.Center
' rh.cells(2,14).Style.TextAlignVert=prt.AlignVertEnum.Center
' rh.Cells(2,14).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black) '去掉第二行的网格线
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''对表体进行赋值,同时设定表体字体以及格式
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For RowBlI As Integer = 0 To Tables("乙方情况汇总表_Table1").Rows.Count-1
If Tables("乙方情况汇总表_Table1").Rows(RowBlI)("分配金额") <> 0 Then
SumRow=SumRow+1
rt.Cells(SumRow+2,2).text=Cstr(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("开发产品"))
rt.Cells(SumRow+2,2).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,3).text=Cstr(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("合同表所属楼栋"))
rt.Cells(SumRow+2,3).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,4).text=Cstr(format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("各种面积_实际总面积"),"00.00"))
rt.Cells(SumRow+2,4).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,5).text=Cstr(format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("各种面积_动态总价"),"00.00"))
rt.Cells(SumRow+2,5).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,6).text=Cstr(format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("预付产值最终实际产值累计"),"00.00"))
rt.Cells(SumRow+2,6).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,7).text=Cstr(format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("预付应付进度款_实际比例"),"00%"))
rt.Cells(SumRow+2,7).Style.Font = New Font("宋体", 9, FontStyle.Regular)
'rt.Cells(SumRow+2,7).text=Tables("乙方情况汇总表_Table1").Rows(RowBlI)("合同约定付款比例") '合同约定付款比例
rt.Cells(SumRow+2,8).text=Cstr(format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("最终实际产值应付进度款_总累计"),"00.00"))
rt.Cells(SumRow+2,8).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,9).text=Cstr(format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("财务付款金额_全部累计"),"00.00"))
rt.Cells(SumRow+2,9).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,10).text=Cstr(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("欠款金额"))
rt.Cells(SumRow+2,10).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,11).text=Cstr(Format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("当前付款比例"),"00%"))
rt.Cells(SumRow+2,11).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(SumRow+2,12).text=Cstr(Format(Tables("乙方情况汇总表_Table1").Rows(RowBlI)("分配金额"),"00.000000"))
rt.Cells(SumRow+2,12).Style.Font = New Font("宋体", 9, FontStyle.Regular)
End If
Next
''''''''''''''
'''无论单页能够容纳几行,都保证横坐标的第一个值等于3,即u-4=3
'''如果单页行数为5,那么u-2=3,基数要发生变化
'''''''''''''
If SumRow <7 Then
rt.cells(3,1).SpanRows=SumRow
rt.cells(3,1).text=Tables("日期可调资金计划表").Rows(CurrentRow)("乙方") '单元格赋值
rt.Cells(3,1).Style.Font = New Font("宋体", 9, FontStyle.Regular)
Else
For u As Integer=3 To SumRow
If u Mod 7=0 Then
rt.cells(u-4,1).SpanRows=7
rt.cells(u-4,1).text=Tables("日期可调资金计划表").Rows(CurrentRow)("乙方") '单元格赋值
rt.Cells(u-4,1).Style.Font = New Font("宋体", 9, FontStyle.Regular)
Else
If u\7 >0 Then
rt.cells(u+2,1).SpanRows=SumRow+1-u
rt.cells(u+2,1).text=Tables("日期可调资金计划表").Rows(CurrentRow)("乙方") '单元格赋值
rt.Cells(u+2,1).Style.Font = New Font("宋体", 9, FontStyle.Regular)
End If
End If
Next
End If
rt.Cells(SumRow+3,1).text="合计"
rt.Rows(SumRow+3).Height=10
rtFooter.Cells(1,1).text=" "
rtFooter.Cells(1,1).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rtFooter.Cells(1,0).text= Chr(9)& Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)& "公司领导:"
rtFooter.Cells(1,0).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rtFooter.Cells(1,0).SpanCols = 6 '合并地二行全部单元格,用于显示副标题
'分层处理
rtFooter.Cells(1,6).text= Chr(9)& Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)&Chr(9)& "成控负责人:"
rtFooter.Cells(1,6).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rtFooter.Cells(1,6).SpanCols =8 '合并地二行全部单元格,用于显示副标题
rtFooter.Cells(1,6).Style.TextAlignHorz = prt.AlignHorzEnum.Left '副标题内容居中
rtFooter.Cells(1,6).Style.Borders.Left=New prt.LineDef("0mm", Color.white) '去掉第二行的网格线
rtFooter.Rows(1).Height = 13 '设置尾行的高度,拉开和表格主体的距离.
'设置列标题
For n As Integer=0 To 13
rt.Cells(3+SumRow,n).Style.Font = New Font("宋体", 9, FontStyle.Regular)
rt.Cells(3+SumRow,n).Style.TextAlignHorz=prt.AlignHorzEnum.Center
rt.Cells(3+SumRow,n).Style.TextAlignVert=prt.AlignVertEnum.Center
rt.Cells(3+SumRow,n).Style.Borders.All=New prt.LineDef("0.1mm", Color.Black)
Next
For j As Integer=0 To SumRow -1
rt.Rows(j+3).Height=10
rt.Cells(j+3,0).text=j+1 '自动填充序号的值
TotalArea =rt.Cells(j+3,4).text+TotalArea '自动填充实际总价单元格的值
rt.Cells(3+SumRow,4).text=Cstr(TotalArea)
TotalPrice =rt.Cells(j+3,5).text+TotalPrice '自动填充实际总面积单元格的值
rt.Cells(3+SumRow,5).text=Cstr(TotalPrice)
FilalOutPutValue =rt.Cells(j+3,6).text+FilalOutPutValue '自动填充实际总产值单元格的值
rt.Cells(3+SumRow,6).text=Cstr(FilalOutPutValue)
ShoudPay =rt.Cells(j+3,8).text+ShoudPay '自动填充实际总应付单元格的值
rt.Cells(3+SumRow,8).text=Cstr(ShoudPay)
HaveToPay =rt.Cells(j+3,9).text+HaveToPay '自动填充实际总已付单元格的值
rt.Cells(3+SumRow,9).text=Cstr(HaveToPay)
NonPayment =rt.Cells(j+3,10).text+NonPayment '自动填充实际总未付单元格的值
rt.Cells(3+SumRow,10).text=Cstr(NonPayment)
Distribution =Format(rt.Cells(j+3,12).text+Distribution,"00.000000") '自动填充实际总分配单元格的值
rt.Cells(3+SumRow,12).text=CsTR(Distribution)
rt.Cells(j+3,0).Style.Font = New Font("宋体", 9, FontStyle.Regular)
If rt.Cells(j+4,2).text=rt.Cells(j+3,2).text Then
rt.Cells(j+3,2).SpanRows=2 '向下合并2个单元格------开发产品重复项
If j<>0 And (j+1) Mod 7=0 Then
rt.Cells(j+3,2).SpanRows=1
End If
If rt.Cells(j+3,2).text=rt.Cells(j+4,2).text And rt.Cells(j+4,2).text=rt.Cells(j+5,2).text Then '三条相同
rt.Cells(j+3,2).SpanRows=3 '向下合并三个单元格
If j<>0 And (j+2) Mod 7=0 Then
rt.Cells(j+3,2).SpanRows=2
End If
If rt.Cells(j+3,2).text=rt.Cells(j+4,2).text And rt.Cells(j+4,2).text=rt.Cells(j+5,2).text And rt.Cells(j+5,2).text=rt.Cells(j+6,2).text Then '四条相同
rt.Cells(j+3,2).SpanRows=4
If j<>0 And (j+3) Mod 7=0 Then
rt.Cells(j+3,2).SpanRows=3
End If
If rt.Cells(j+3,2).text=rt.Cells(j+4,2).text And rt.Cells(j+4,2).text=rt.Cells(j+5,2).text And rt.Cells(j+5,2).text=rt.Cells(j+6,2).text And rt.Cells(j+7,2).text=rt.Cells(j+6,2).text Then '五条相同
rt.Cells(j+3,2).SpanRows=5
If j<>0 And (j+4) Mod 7=0 Then
rt.Cells(j+3,2).SpanRows=4
End If
If rt.Cells(j+3,2).text=rt.Cells(j+4,2).text And rt.Cells(j+4,2).text=rt.Cells(j+5,2).text And rt.Cells(j+5,2).text=rt.Cells(j+6,2).text And rt.Cells(j+7,2).text=rt.Cells(j+6,2).text And rt.Cells(j+7,2).text=rt.Cells(j+8,2).text Then '六条相同
rt.Cells(j+3,2).SpanRows=6
If j<>0 And (j+5) Mod 7=0 Then
rt.Cells(j+3,2).SpanRows=5
End If
If rt.Cells(j+3,2).text=rt.Cells(j+4,2).text And rt.Cells(j+4,2).text=rt.Cells(j+5,2).text And rt.Cells(j+5,2).text=rt.Cells(j+6,2).text And rt.Cells(j+7,2).text=rt.Cells(j+6,2).text And rt.Cells(j+7,2).text=rt.Cells(j+8,2).text And rt.Cells(j+9,2).text=rt.Cells(j+8,2).text Then '六条相同
rt.Cells(j+3,2).SpanRows=7
If j<>0 And (j+6) Mod 7=0 Then
rt.Cells(j+3,2).SpanRows=6
End If
End If
End If
End If
End If
End If
End If
Next
Doc.PageHeader=rh
Doc.PageFooter=rtFooter
Doc.Preview() '预览报表
End If
End With