- 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=95616)
-- 发布时间：2017/1/25 16:11:00
-- [求助]生成word报表后，合并第一列单元格
蓝版主好！
以前问过的问题，没能够完全解决。现在重新设计了Word模板，其他代码都有了，想增加下列两项：
1、生成word报表后，如果该行第二列的值为空，那么删除该行；
2、然后再合并第一列单元格。
附件
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:aa1.rar |
谢谢！
-- 发布时间：2017/1/26 15:09:00
--
\'\'\'
\'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) \'指定目标文件
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)
For Each k As object In doc.Paragraphs
k.Range.Select
If Len(k.Range.text) = 1 Then k.Range.Delete
Do
If app.Selection.Characters(1).Text = Chr(10) Then app.Selection.Characters(1).Delete
Loop Until app.Selection.Characters(1).Text <> Chr(10)
Next
\'删除表格空行：
Dim tb As Object, r As Object
With Doc
Dim c1 As object
Dim c2 As object
Dim text As String
For Each tb In .Tables
Dim count As Integer = 0
For Each r In tb.Rows
c1 = r.Cells(2)
text = doc.Range(c1.Range.Start, c1.Range.End - 1).Text
If len(text) = 0 Then
r.Delete
End If
Next
Dim dict As new Dictionary(of Integer, object)
Dim lst As new List(of String)
For i2 As Integer = 1 To tb.Range.cells.count
c1 = tb.Range.cells(i2)
If c1.ColumnIndex = 1 Then
dict.Add(i2,c1)
lst.Add(i2)
End If
Next
c1 = dict(lst(lst.Count -1))
text = doc.Range(c1.Range.Start, c1.Range.End - 1).Text
For j2 As Integer = lst.Count -2 To 0 Step -1
c2 = dict(lst(j2))
Dim txt = doc.Range(c2.Range.Start, c2.Range.End - 1).Text
If txt = text Then
c2.Merge(c1)
c2.Range.Text = text
Else
text = txt
End If
c1 = c2
Next
Next
End With
doc.save
app.quit
catch ex As exception
msgbox(ex.message)
app.quit
End try
End If
Next
Next
\'提示窗口：是否查看
Dim Result As DialogResult
Result = MessageBox.Show("文书生成完毕！"& vbcrlf &"是---查看"& vbcrlf &"否---退出", "提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If Result = DialogResult.Yes Then
Dim Proc As New Process
Proc.File = ProjectPath & "\\成品文件"
proc.start
Forms("生成文书").Close()
Else
Forms("生成文书").Close()
End If