| 以文本方式查看主题 - Foxtable(狐表) (http://foxtable.com/bbs/index.asp) -- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2) ---- 内部函数问题 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=126509) |
| -- 作者：xietan417 -- 发布时间：2018/10/23 11:25:00 -- 内部函数问题 我想把红色部份做成内部函数应该怎么改？ Dim doc As New PrintDoc \' 定义一个报表 Dim Line As New prt.LineDef(0.5, Color.Black) \' 定义一条黑色的线条 Dim rt As Prt.RenderTable \' 定义一个表格对象 Dim rx As prt.RenderText \' 定义一个文本对象 Dim rm As New prt.RenderImage() \'定义一个图片对象 rm.Image = GetImage("EGLOGO.png") \'设置图片 Dim CurRow As Row = Tables("报价单主表").Current Dim tbl As Table = Tables("报价单主表.报价单明细") Dim Rows As List(Of DataRow) Dim Regions As List(Of String) = tbl.DataTable.GetValues("报价大类","[RCId] = \'" & CurRow("RCId") & "\'","大类序号") doc.Pagesetting.LandScape = False \'只需将Landscape属性设为True,即可横向打印. Doc.PageSetting.LeftMargin = 10 \'设置左边距 Doc.PageSetting.RightMargin = 10 \'设置右边距 Doc.PageSetting.TopMargin = 10 \'设置上边距 Doc.PageSetting.BottomMargin = 10 \'设置下边距 rt = New prt.RenderTable rt.Style.GridLines.All = New prt.Linedef \'设置网格线 rt.Height = 25 rt.Rows.Count = 3 \'设置行数 rt.Cols.Count = 6 \'设置列数 rt.CellStyle.Spacing.All = 0.01 \'内容距离网格线1毫米 rt.Cells(0,0).RenderObject = rm \'将单元格内容设置为图片对象rm rt.Cells(0,0).SpanRows = 3 rm.Style.ImageAlign.AlignHorz = prt.ImageAlignHorzEnum.Right \'图片水平居中 rm.Style.ImageAlign.AlignVert = prt.ImageAlignVertEnum.Center \'图片垂直居中 rm.Style.ImageAlign.StretchHorz = True \'禁止水平方向扩展图片 rm.Style.ImageAlign.StretchVert = True \'禁止垂直方向扩展图片 rt.Style.GridLines.All = New prt.LineDef("0mm", Color.white) \'去掉所有的网格线 \'设置主标题 rt.Cells(0,1).SpanCols = 5 \'合并第一行全部单元格,用于显示主标题 rt.Cells(0,1).text = "Dong Guan Ever Gain Logistics Management Co., Ltd." rt.Cells(0,1).Style.TextAlignHorz = prt.AlignHorzEnum.Left \'主标题居左 rt.Cells(0,1).Style.Font = New Font("Times New Roman", 15 , FontStyle.Bold) \'设置文本对象的字体 rt.Rows(0).Height = 8 Dim cb As WinForm.CheckBox = e.Form.Controls("CheckBox2") \'成本 Dim sl As WinForm.CheckBox = e.Form.Controls("CheckBox3") \'含税 Dim zx As WinForm.CheckBox = e.Form.Controls("CheckBox4") \'子项目 \'----------------------------------------------------------------------------------------------------------------------显示成本 If cb.Checked = False Then For Each Region As String In Regions rx = New prt.RenderText \'创建文本对象 rx.Style.FontSize = 10 \'字体大小为8磅 rx.Style.FontBold = True \'加粗字体 rx.Style.Spacing.Bottom = 2 \'和下面的对象(表格)距离2毫米 rx.Text = Region \'报价大类 doc.Body.Children.Add(rx) \' 加入至报表中 rt = New prt.RenderTable \'创建文本对象 \'rt.Style.Font = Tables("报价单主表.报价单明细").Font \'字体 rt.Style.Font = New Font("微软雅黑",7,FontStyle.Bold) \'设置文本对象的字体 rt.Style.TextAlignVert = prt.AlignVertEnum.Center \'\'垂直居中 rt.Style.GridLines.All = New prt.LineDef(0.2,Color.Black) \'设置网格线颜色 rt.Style.Spacing.Bottom = 3 \'和下面的对像距离为3毫米 \'rt.SplitVertBehavior = prt.SplitBehaviorEnum.Never \'禁止被垂直分割 rt.CellStyle.Spacing.All = 1 \'单元格内距设为1毫米 rt.Style.Font = tbl.Font Rows = tbl.DataTable.Select("[报价大类] = \'" & Region & "\'And [RCId] = \'" & CurRow("RCId") & "\'", "dno") \'筛选报价大类 \'Rows = tbl.DataTable.Select("[报价大类] = \'" & Region & "\'And [RCId] = \'" & CurRow("RCId") & "\'", "报价序号,CODE,项目") \'筛选报价大类 Dim ColNames As String() = New String(){"报价序号","项目","二级项目","币种","金额","成本","单位","税率","备注"} \'明细列名集合 Dim cn As String() = New String(){"NO.","项目","子项目","币种","未税金额","成本","单位","税率","备注"} \' 明细列名的别名 Dim mc As Integer = 3 \'合并前三个列 \'tbl.Sort ="报价序号,CODE,项目" For c As Integer = 0 To ColNames.Length - 1 Dim lr As Integer \'用于保存合并区域的起始行 rt.Cells(0,c).Text = cn(c) \'第一列使用别名 rt.Cells(0,c).Style.TextAlignHorz = prt.AlignHorzEnum.Center \'rt.Cols(c).Width = tbl.Cols(c).PrintWidth rt.Cols(0).Width = 10 \'第一列列宽(打价序号) rt.Cols(1).Width = 40 \'项目 rt.Cols(2).Width = 30 rt.Cols(3).Width = 10 rt.Cols(4).Width = 14 rt.Cols(5).Width = 15 rt.Cols(6).Width = 12 rt.Cols(7).Width = 10 rt.Cols(7).Style.WordWrap = True \'自动换行 rt.Cols(0).Style.TextAlignHorz = prt.AlignHorzEnum.Center \'唯独第一列内容居中 rt.Cols(1).Style.TextAlignHorz = prt.AlignHorzEnum.Left For r As Integer = 0 To Rows.Count -1 \'当前大类的行数 If c <= mc -1 Then \'如果是要合并的列 Dim merge As Boolean = True If r = 0 Then merge = False Else For n As Integer = 0 To c \'历遍要合并的列 If Rows(r)(Colnames(n)) <> 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 = rows(r)(ColNames(c)) lr = r + 1 End If Else If cn(c) = "税率" Then rt.Cells(r+1,c).text = Format(rows(r)(ColNames(c)),"0%") Else rt.Cells(r + 1,c).Text = rows(r)(ColNames(c)) End If If cn(c) = "未税金额" Then If rt.Cells(r+1,c).text = 0 Then rt.Cells(r+1,c).text = "" Else rt.Cells(r+1,c).text = Format(rows(r)(ColNames(c)),"n")\'对未税金额进行千分位格式化 End If End If If cn(c) = "成本" Then If rt.Cells(r+1,c).text = 0 Then rt.Cells(r+1,c).text = "" Else rt.Cells(r+1,c).text = Format(rows(r)(ColNames(c)),"n")\'对成本进行千分位格式化 End If End If End If Next Next rt.RowGroups(0,1).Header = prt.TableHeaderEnum.All \'将第一行作为表头. rt.Style.Font = New Font("微软雅黑", 7, FontStyle.Bold) \'设置字体 doc.Body.Children.Add(rt) Next \'-----------------------------------------------------------------------------------------------------------不显示成本 ElseIf cb.Checked = True Then For Each Region As String In Regions rx = New prt.RenderText \'创建文本对象 rx.Style.FontSize = 10 \'字体大小为8磅 rx.Style.FontBold = True \'加粗字体 rx.Style.Spacing.Bottom = 2 \'和下面的对象(表格)距离2毫米 rx.Text = Region \'报价大类 doc.Body.Children.Add(rx) \' 加入至报表中 rt = New prt.RenderTable \'创建文本对象 \'rt.Style.Font = Tables("报价单主表.报价单明细").Font \'字体 rt.Style.Font = New Font("微软雅黑",7,FontStyle.Bold) \'设置文本对象的字体 \'rt.Style.TextAlignVert = prt.AlignVertEnum.Center \'\'垂直居中 rt.Style.GridLines.All = New prt.LineDef(0.2,Color.Black) \'设置网格线颜色 rt.Style.Spacing.Bottom = 3 \'和下面的对像距离为3毫米 \'rt.SplitVertBehavior = prt.SplitBehaviorEnum.Never \'禁止被垂直分割 rt.CellStyle.Spacing.All = 1 \'单元格内距设为1毫米 rt.Style.Font = tbl.Font Rows = tbl.DataTable.Select("[报价大类] = \'" & Region & "\'And [RCId] = \'" & CurRow("RCId") & "\'", "dno") \'筛选报价大类 \'Rows = tbl.DataTable.Select("[报价大类] = \'" & Region & "\'And [RCId] = \'" & CurRow("RCId") & "\'", "报价序号,CODE,项目") \'筛选报价大类 Dim ColNames As String() = New String(){"报价序号","项目","二级项目","币种","金额","单位","税率","备注"} \'明细列名集合 Dim cn As String() = New String(){"NO.","项目","子项目","币种","未税金额","单位","税率","备注"} \' 明细列名的别名 Dim mc As Integer = 3 \'合并前三个列 \'tbl.Sort ="报价序号,CODE,项目" For c As Integer = 0 To ColNames.Length - 1 Dim lr As Integer \'用于保存合并区域的起始行 rt.Cells(0,c).Text = cn(c) \'第一列使用别名 rt.Cells(0,c).Style.TextAlignHorz = prt.AlignHorzEnum.Center \'rt.Cols(c).Width = tbl.Cols(c).PrintWidth rt.Cols(0).Width = 10 \'第一列列宽(打价序号) rt.Cols(1).Width = 40 \'项目 rt.Cols(2).Width = 30 rt.Cols(3).Width = 10 rt.Cols(4).Width = 14 rt.Cols(5).Width = 12 rt.Cols(6).Width = 10 rt.Cols(7).Width = 10 rt.Cols(7).Style.WordWrap = True \'自动换行 rt.Cols(0).Style.TextAlignHorz = prt.AlignHorzEnum.Center \'唯独第一列内容居中 rt.Cols(1).Style.TextAlignHorz = prt.AlignHorzEnum.Left For r As Integer = 0 To Rows.Count -1 \'当前大类的行数 If c <= mc -1 Then \'如果是要合并的列 Dim merge As Boolean = True If r = 0 Then merge = False Else For n As Integer = 0 To c \'历遍要合并的列 If Rows(r)(Colnames(n)) <> 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 = rows(r)(ColNames(c)) lr = r + 1 End If Else If cn(c) = "税率" Then rt.Cells(r+1,c).text = Format(rows(r)(ColNames(c)),"0%") Else rt.Cells(r + 1,c).Text = rows(r)(ColNames(c)) End If If cn(c) = "未税金额" Then If rt.Cells(r+1,c).text = 0 Then rt.Cells(r+1,c).text = "" Else rt.Cells(r+1,c).text = Format(rows(r)(ColNames(c)),"n")\'对未税金额进行千分位格式化 End If End If If cn(c) = "成本" Then If rt.Cells(r+1,c).text = 0 Then rt.Cells(r+1,c).text = "" Else rt.Cells(r+1,c).text = Format(rows(r)(ColNames(c)),"n")\'对成本进行千分位格式化 End If End If End If Next Next rt.RowGroups(0,1).Header = prt.TableHeaderEnum.All \'将第一行作为表头. rt.Style.Font = New Font("微软雅黑", 7, FontStyle.Bold) \'设置字体 doc.Body.Children.Add(rt) Next End If rt.Style.TextAlignHorz = prt.AlignHorzEnum.left \'所有文本内容靠右对齐 rt.Style.Spacing.Bottom = 2 doc.preview()
|
| -- 作者：有点甜 -- 发布时间：2018/10/23 12:35:00 -- 1、把需要的参数全部传递过去
Functions("test", Regions, rt, doc 等等....)
2、在函数头部接收这些参数
Dim Regions = args(0) Dim rt = args(1)
3、拷贝代码过去写在后面 |
| -- 作者：xietan417 -- 发布时间：2018/10/23 13:47:00 -- 好的!我试一下 |
| -- 作者：xietan417 -- 发布时间：2018/10/23 15:09:00 -- 搞定，还领会了内部函数的用法！谢谢甜版！ |