Foxtable(狐表)用户栏目专家坐堂 → [求助]生成word报表后,合并第一列单元格


  共有2402人关注过本帖树形打印复制链接

主题:[求助]生成word报表后,合并第一列单元格

帅哥哟,离线,有人找我吗?
jyh7081
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:962 积分:8505 威望:0 精华:0 注册:2012/10/3 13:25:00
[求助]生成word报表后,合并第一列单元格  发帖心情 Post By:2017/1/25 16:11:00 [只看该作者]

蓝版主好!
以前问过的问题,没能够完全解决。现在重新设计了Word模板,其他代码都有了,想增加下列两项:
1、生成word报表后,如果该行第二列的值为空,那么删除该行;
2、然后再合并第一列单元格。

附件
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:aa1.rar


谢谢!

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110579 积分:562791 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By: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

 回到顶部