根据修改的代码我重新调了下，但是会出现如下图的错误（红框标注的地方，大部分合适，有个别地方就会出现问题），麻烦帮忙看看
此主题相关图片如下：qq截图20191108121424.png
此主题相关图片如下：qq截图20191108121302.png
'//////////////////生成表格的代码
Dim app As New MSWord.Application
try
Dim doc = app.Documents.Open(ProjectPath & "\Reports\病害整理.doc")
Dim tbl As Table = Tables("病害统计表") '定义一个表
Dim Regions As List(Of String) = tbl.DataTable.GetValues("桥梁名称") '从指定列中,获取不重复的值,以字符集合的形式返回|桥梁代码|部件名称
Dim WdLine = MSWord.WdUnits.wdLine
Dim tcount = 2
For Each Region As String In Regions
Dim drs As List(of DataRow) = tbl.DataTable.Select("[桥梁名称] = '" & Region & "'","Bjpx,构件编号")
For Each dr As DataRow In drs
app.Selection.TypeText (Text:= Region) '写桥明
doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= 5) '返回一个 Table 对象,该对象代表添加至文档中的空白新表格
'///定义表格格式
With app.Selection.Tables(1)
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Style = "网格型"
'.Cell(1,1).SetWidth (ColumnWidth:=36,RulerStyle:= wdAdjustNone)
End With
Dim cls() As String = {"部件名称","构件编号","细部位置","缺损情况病害描述","照片或图片"}
For Each Name As String In cls '写表头
app.Selection.TypeText(Text:=Name)
app.Selection.MoveRight(Unit:=12)
Next
For j As Integer = 0 To drs.Count - 1
dr = drs(j)
For Each name As String In cls
app.Selection.TypeText(Text:=dr(name)) '插入指定的文本
If j = drs.Count - 1 AndAlso name = "照片或图片"
Else
app.Selection.MoveRight(Unit:=12)
End If
Next
Next
app.Selection.MoveDown(WdLine , tcount , Nothing)
'///////添加照片
For r As Integer = 0 To drs.Count -1
Dim lst As List(of String) = drs(r).lines("照片或图片")
For Each s As String In lst
Dim img = ProjectPath & "Attachments\" & s '图片路径
Dim rg = app.Selection.InlineShapes.AddPicture( img ,False,True) '插入照片
rg.Width = 217.6 '图片宽(7.7cm)
rg.Height=217.6 '图片高
Next
Next
app.Selection.TypeParagraph()
'/////添加照片
Exit For
Next
Next
'app.Visible = True
MessageBox.Show("输出完成")
catch ex As exception
msgbox(ex.message)
app.Quit
finally
End try
加好友 
发短信
Post By：2019/11/7 10:14:00 [只看该作者]
此主题相关图片如下：病害整理.jpg
