以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  Word报表格式问题  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=138048)
--  作者：benwong2013
--  发布时间：2019/7/22 8:54:00
--  Word报表格式问题
在生成word报表的时候，希望如下：

1. 插入行之后，将字体取消粗体，标示黄色的代码有问题，请帮忙指点；
另外想实现以下功能：
2. 表格中的行高能根据内容自动调整；
3. 若当前页不够是，能自动换页并插入表格； 

Dim dr As Row = Tables("T_Report").Current

Dim bh As String = dr("报告格式编号")
Dim bz As String
bz = DataTables("T_Item").GetComboListString("标准","报告编号 = \'"& dr("报告编号") &"\'")
Dim tm As String  = ProjectPath & "Attachments\\DGN\\" & bh & ".doc" \'指定模板文件
Dim fl As String = ProjectPath & "Reports\\" & dr("报告编号") & " " & dr("样品名称") & ".Doc" \'指定目标文件
Dim wrt As New WordReport(Tables("T_Report"),tm,fl) \'定义一个WordReport
wrt.BuildOne(dr)
wrt.Quit
Dim app As New MSWord.Application
try
    Dim fileName = ProjectPath & "Reports\\" & dr("报告编号") & " " & dr("样品名称") & ".Doc" \'指定目标文件
    Dim doc As Object = app.Documents.Open(fileName)
    
    app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
    If app.Selection.Find.Execute("CTTREPORT") Then \'查找到指定字符串
        app.Selection.Text =" " & dr("报告编号") & "" \'替换字符串
    End If
    
    
    app.Activedocument.Bookmarks("项目清单").Range.Tables(1).Select
    Dim xh As Integer = 0
    Dim zrs As List(of DataRow) = DataTables("T_Item").Select("报告编号 = \'"& dr("报告编号") &"\'")
    For Each zr As DataRow In zrs
        xh = xh + 1
        app.Selection.InsertRowsBelow(1)
        app.Selection.Font.Bold = app.wdToggle
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=xh)
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=zr("检测项目"))
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=zr("检测方法"))
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=zr("结果"))
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=zr("标准要求"))
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=zr("单位"))
        app.Selection.MoveRight(Unit:=12)
        app.Selection.TypeText(Text:=zr("判定"))
        
    Next
    app.ActiveWindow.ActivePane.View.SeekView =  MSWord.WdSeekView.wdSeekMainDocument
    app.Visible = True
catch ex As exception
    msgbox(ex.message)
    app.Quit
finally
    \'app.Quit
End try
--  作者：有点蓝
--  发布时间：2019/7/22 9:55:00
--  
1、app.Selection.Font.Bold = 0
2、没找到自动调整的方法。
3、试试

Doc.Tables(1).Rows.AllowBreakAcrossPages  = true
Doc.Tables(1).Rows.HeadingFormat = true