[求助]求合并三段代码 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

第一、二段代码可在foxtable中分别独立运行，但没有衔接好；第三段代码是word中的VBA代码，不知如何加进来，请帮忙，谢谢！

附件：

下载信息 [文件大小：下载次数： ]
点击浏览该文件:aa.rar

'第一段代码:写入word模板,生成word报表:

Dim clbx1 As WinForm.CheckedListBox = e.Form.Controls("CheckedListBox1")

Dim clbx2 As WinForm.CheckedListBox = e.Form.Controls("CheckedListBox2")

For Each j As String In clbx2.CheckedIndices

Dim tm As String = ProjectPath & "模板文件\" & clbx2.Items(j) '指定模板文件

For Each i As Integer In clbx1.CheckedIndices

Dim fl As String = ProjectPath & "成品文件\" & clbx1.items(i) & clbx2.Items(j) '指定目标文件

'文件已经存在,是否覆盖重新填写

If FileSys.FileExists(fl) Then

If MessageBox.Show(fl & "文件已经存在,是否覆盖重新填写?","提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.No Then

Continue For

End If

Dim nm As String = CurrentTable.Name

Dim dr As DataRow =DataTables(nm).Find("名称 = '" & clbx1.items(i) & "'")

'写入模板

If dr IsNot Nothing

Dim wrt As New WordReport(Tables(nm),tm,fl) '定义一个WordReport

wrt.BuildOne(dr)

wrt.quit

End If

'第二段代码，删除生成的word报表中的空行:

Dim app As New MSWord.Application

try

Dim doc = app.Documents.Open("fl")

For Each k As object In doc.Paragraphs

If Len(Trim(k.Range.text)) = 1 Then k.Range.Delete

doc.save

app.quit

catch ex As exception

msgbox(ex.message)

app.quit

End try

'第三段代码,word报表重新排版:

'删除手动换行符和假段落标记----这两句放到删除空行之前，

ActiveDocument.Content.Find.Execute FindText:="^l", replacewith:="^p", Replace:=wdReplaceAll

ActiveDocument.Content.Find.Execute FindText:="^13", replacewith:="^p", Replace:=wdReplaceAll

'取消缩进，重新缩进，

Selection.WholeStory '全选

With Selection.ParagraphFormat '选定区域段落设置

.CharacterUnitFirstLineIndent = 0 '取消首行缩进

.FirstLineIndent = CentimetersToPoints(0)

.CharacterUnitLeftIndent = 2 '左缩进2字符

End With

Selection.HomeKey unit:=wdStory '光标移至文首

版主，经过一下午的调试，没有出现问题。太感谢了！

还有个问题，当word报表是表格时，如果存在空表行需要删除，我加了一段代码（在word的可有效运行的VBA），并进行了修改，但还有是不能运行，请老师再给看看（加黑部分代码）：

'''

'word报表:带表格

Dim clbx1 As WinForm.CheckedListBox = e.Form.Controls("CheckedListBox1")

Dim clbx2 As WinForm.CheckedListBox = e.Form.Controls("CheckedListBox2")

For Each j As String In clbx2.CheckedIndices

Dim tm As String = ProjectPath & "模板文件\" & clbx2.Items(j) '指定模板文件

For Each i As Integer In clbx1.CheckedIndices

Dim fl As String = ProjectPath & "成品文件\" & clbx1.items(i) & clbx2.Items(j) '指定目标文件

'文件已经存在,是否覆盖重新填写

If FileSys.FileExists(fl) Then

If MessageBox.Show(fl & "文件已经存在,是否覆盖重新填写?","提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.No Then

Continue For

End If

Dim nm As String = CurrentTable.Name

Dim dr As DataRow =DataTables(nm).Find("案号 = '" & clbx1.items(i) & "'")

If dr IsNot Nothing

Dim wrt As New WordReport(Tables(nm),tm,fl) '定义一个WordReport

wrt.BuildOne(dr)

wrt.quit

Dim app As New MSWord.Application

try

Dim doc = app.Documents.Open(fl)

doc.Content.Find.Execute(FindText:="^l", replacewith:="^p", Replace:=2)

doc.Content.Find.Execute(FindText:="^13", replacewith:="^p", Replace:=2)

'删除表格空行：

Dim tb As Table, r As Row

With doc

For Each tb In .Tables

For Each r In tb.Rows

r.Range.Find.Execute(FindText:="^l", replacewith:="^p", Replace:=2)

r.Range.Find.Execute(FindText:=" ", replacewith:="", Replace:=2)

r.Range.Find.Execute(FindText:="^w", replacewith:="", Replace:=2)

If Len(Replace(Replace(r.Range.Text, vbCr, ""), Chr(7), "")) = 0 Then r.Delete

End With

doc.save

app.quit

catch ex As exception

msgbox(ex.message)

app.quit

End try

End If

MessageBox.Show( "生成完毕!")'

版主，还有一个问题：有一种换行符没有替换掉（狐表单元格内的Ctrl+回车产生的），在word报表中可以用删除行代码去掉它，vba代码如下：

Sub 删除空行()

Dim i As Paragraph

For Each i In ActiveDocument.Paragraphs

i.Range.Select

If Len(i.Range) = 1 Then i.Range.Delete

If Selection.Characters(1).Text = Chr(10) Then Selection.Characters(1).Delete

Loop Until Selection.Characters(1).Text <> Chr(10)

End Sub

我改成狐表中的代码，但显示“类型不匹配”，麻烦你再给看看，谢谢！

’ 删除空行

For Each k As object In doc.Paragraphs

k.Range.Select

If Len(k.Range) = 1 Then k.Range.Delete

If app.Selection.Characters(1).Text = Chr(10) Then app.Selection.Characters(1).Delete

Loop Until app.Selection.Characters(1).Text <> Chr(10)

主题：[求助]求合并三段代码