Foxtable(狐表)用户栏目专家坐堂 → [求助]求合并三段代码


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

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

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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2016/8/28 12:53:00 [显示全部帖子]

'第一段代码:写入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
        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)
                For Each k As object In doc.Paragraphs
                    If Len(Trim(k.Range.text)) = 1 Then k.Range.Delete
                Next
                doc.Content.Find.Execute(FindText:="^l", replacewith:="^p", Replace:=2)
                doc.Content.Find.Execute(FindText:="^13", replacewith:="^p", Replace:=2)
                app.Selection.WholeStory   '全选
                With app.Selection.ParagraphFormat  '选定区域段落设置
                    .CharacterUnitFirstLineIndent = 0   '取消首行缩进
                    .FirstLineIndent = 0
                    .CharacterUnitLeftIndent = 2   '左缩进2字符
                End With
                app.Selection.HomeKey(unit:=6)    '光标移至文首
                doc.save
                app.quit
            catch ex As exception
                msgbox(ex.message)
                app.quit
            End try
        End If
    Next
Next


 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2016/8/28 17:18:00 [显示全部帖子]

Dim tb As Table, r As Row

 

改成

 

Dim tb As Object, r As Object


 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2016/8/29 9:48:00 [显示全部帖子]

 

                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


 回到顶部