Foxtable(狐表)用户栏目专家坐堂 → [求助]如何批量修改WORD页眉


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

主题:[求助]如何批量修改WORD页眉

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


加好友 发短信
等级:童狐 帖子:242 积分:2417 威望:0 精华:0 注册:2011/6/19 0:05:00
[求助]如何批量修改WORD页眉  发帖心情 Post By:2018/2/8 11:51:00 [只看该作者]

一、员工资料表
工号    姓名
YG001 李三
YG002
YG003
YG004

二、生成的word报表
YG004詹.doc
YG003何.doc
YG002张.doc
YG001李三.doc

三、批量修改多个WORD文档页眉的代码(所有代码在专业报表-报表管理)

以下内容为程序代码:

1 '批量修改页眉
2 Dim t As Table = Tables("员工资料")
3 For i As Integer = t.TopPosition To t.BottomPosition
4 Dim r As Row = t.Rows(i)
5 Dim fl As String = ProjectPath & "Reports\" & r("工号") & r("姓名") & ".doc" '指定目标文件
6 Dim app As New MSWord.Application
7 try
8 'Dim fileName = ProjectPath & "Reports\" & Tables("员工资料").current("编号") & " " & Tables("T").current("名称") & ".Doc"
9 'Dim fileName = ProjectPath & "Reports\" & "员工资料.Doc"
10
11 Dim doc As Object = app.Documents.Open(fl) '测试可以打开每个文件
12
13 app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
14 If app.Selection.Find.Execute("[编号]") Then '查找到指定字符串
15 app.Selection.Text ="" &r("工号") & "-" &r("姓名") & "" '此处只能用第一条记录的工号和姓名替换字符串[编号]
16 'app.Selection.Text ="测试编号" '替换字符串
17 End If
18 app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument
19
20 app.Visible = True
21 catch ex As exception
22 msgbox(ex.message)
23 app.Quit
24 finally
25 'app.Quit
26 End try
27 Next


四、问题
1、所有的页眉都是YG001-李三
2、所有修改的文档均打开。

五、请问如何按WORD文档内容更新页眉,另外修改后如何关闭。
例如:
YG002张.doc的页眉是YG002-张
YG003何.doc的页眉是YG003-何
 下载信息  [文件大小:   下载次数: ]
点击浏览该文件:员工资料.rar




[此贴子已经被作者于2018/2/8 11:54:51编辑过]

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/2/8 11:57:00 [只看该作者]

1、这个判断进入执行了没有?

 

If app.Selection.Find.Execute("[编号]") Then '查找到指定字符串

    msgbox(123)
    app.Selection.Text ="" &r("工号") & "-" &r("姓名") & "" '此处只能用第一条记录的工号和姓名替换字符串[编号]

    msgbox(app.Selection.Text_
End If

 

2、你的页眉怎么设计的?截图贴出来。


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


加好友 发短信
等级:童狐 帖子:242 积分:2417 威望:0 精华:0 注册:2011/6/19 0:05:00
  发帖心情 Post By:2018/2/8 15:43:00 [只看该作者]


图片点击可在新窗口打开查看此主题相关图片如下:模版和输出.jpg
图片点击可在新窗口打开查看

另外,msgbox不输出内容。

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/2/8 15:58:00 [只看该作者]

你代码本身就是没问题的。没做任何修改。

 

'批量生成多个word报表
Dim tm As String  = ProjectPath & "Attachments\员工资料.doc" '指定模板文件
'批量修改页眉
Dim t As Table = Tables("员工资料")
For i As Integer = t.TopPosition To t.BottomPosition
    Dim r As Row = t.Rows(i)
    Dim fl As String = ProjectPath & "Reports\" & r("工号") & r("姓名") & ".doc" '指定目标文件
   
    Dim wrt As New WordReport(t,tm,fl) '定义一个WordReport
    wrt.Buildone(r) '逐行生成报表
    wrt.quit
   
    Dim app As New MSWord.Application
    try
        'Dim fileName = ProjectPath & "Reports\" & Tables("员工资料").current("编号") & " " & Tables("T").current("名称") & ".Doc"
        'Dim fileName = ProjectPath & "Reports\" & "员工资料.Doc"
       
        Dim doc As Object = app.Documents.Open(fl) '测试可以打开每个文件
       
        app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
        If app.Selection.Find.Execute("[编号]") Then '查找到指定字符串
            app.Selection.Text ="" &r("工号") & "-" &r("姓名") & ""   '此处只能用第一条记录的工号和姓名替换字符串[编号]
            'app.Selection.Text ="测试编号" '替换字符串
        End If
        app.ActiveWindow.ActivePane.View.SeekView =  MSWord.WdSeekView.wdSeekMainDocument
       
        app.Visible = True
    catch ex As exception
        msgbox(ex.message)
        app.Quit
    finally
        'app.Quit
    End try
Next

 


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


加好友 发短信
等级:童狐 帖子:242 积分:2417 威望:0 精华:0 注册:2011/6/19 0:05:00
  发帖心情 Post By:2018/2/8 23:26:00 [只看该作者]

问题解决了。代码如下。第二个问题,如何自动保存关闭。
Dim t As Table = Tables("员工资料")
For i As Integer = t.TopPosition To t.BottomPosition
    Dim r As Row = t.Rows(i)
    Dim fl As String = ProjectPath & "Reports\" & r("工号") & r("姓名") & ".doc" '指定目标文件
    Dim bh As String = r("工号") & "-" & r("姓名")
    Dim app As New MSWord.Application
    try
        
        Dim doc As Object = app.Documents.Open(fl) '测试可以打开每个文件
        
        app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
        If app.Selection.Find.Execute("[编号]") Then '查找到指定字符串
            '          app.Selection.Text ="" &Tables("员工资料").r("工号") & "-" &Tables("员工资料").r("姓名") & ""   '此处只能用第一条记录的工号和姓名替换字符串[编号]
            app.Selection.Text =bh
            '         msgbox(bh)
            
        End If
        
        app.ActiveWindow.ActivePane.View.SeekView =  MSWord.WdSeekView.wdSeekMainDocument
        
        app.Visible = True

    catch ex As exception
        msgbox(ex.message)
        app.Quit
    finally
        app.quit
    End try
Next

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/2/9 8:47:00 [只看该作者]

app.Visible = True

 

改成

 

doc.save

app.quit


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


加好友 发短信
等级:童狐 帖子:242 积分:2417 威望:0 精华:0 注册:2011/6/19 0:05:00
  发帖心情 Post By:2018/2/9 10:55:00 [只看该作者]

需求已经实现。非常感谢。

 回到顶部