如何用VBA批量复制页眉表格内容到正文中

沈熠 · 发表于 2022-8-1 11:19

最近公司体系升级，需要统计文件名称、编号以及发放部门，但是文件名称、编号都在页眉中，
文件名称和编号都各不相同，我想把文件名称、编号以及发放部门都放在一起，然后把其余的内容删掉，请问请问各位大神这种需求怎么通过VBA来实现批量修改，十分感谢~~
PS 我找到一个打开保存关闭文件的VBA代码，所以只需要将文件名称、编号以及发放部门都放在一起的代码即可，十分感谢~~

snow653124 · 发表于 2022-8-1 17:44

快下班了，先给你一个半成品，明天上班了再搞批量打开自动运行保存的

Sub 页眉表格()
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With ActiveDocument.Sections(1)
   a1 = .Headers(wdHeaderFooterPrimary).Range.Tables(1).cell(1, 2)
   a2 = Split(a1, Chr(13))(0)
   b1 = .Headers(wdHeaderFooterPrimary).Range.Tables(1).cell(2, 3)
   b2 = Split(b1, Chr(13))(0)
End With
With ActiveDocument.Tables(1)
      c1 = .cell(4, 2)
      c2 = Split(c1, Chr(13))(0)
      .cell(4, 2).Range = a2 & b2 & c2
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

snow653124 · 发表于 2022-8-1 17:50

QQ录屏20220801174111.rar (1.08 MB, 下载次数: 5)

暂时的运行效果，要下班了，先撤了
代码在审核中

413191246se · 发表于 2022-8-1 18:28

* 单个文件处理代码：

Sub DocProcess801()
Dim s$, t$
With ActiveDocument
With .Sections(1).Headers(1).Range.Tables(1).Range
t = Replace(.Cells(4).Range.Text & " + " & .Cells(2).Range.Text, Chr(7), "")
End With
With .Tables(1).Range
s = .Cells(.Cells.Count).Range.Text
s = Replace(t & " + " & s, vbCr, "")
.Cells(.Cells.Count).Range.Text = s
End With
End With
End Sub

复制代码

沈熠 · 发表于 2022-8-2 11:16

snow653124 发表于 2022-8-1 17:44
快下班了，先给你一个半成品，明天上班了再搞批量打开自动运行保存的

感谢大神出手相助~，自动打开保存关闭的代码我之前找到啦~
我还想把除了文件名称、编号以及发放部门的表格之外的内容都删掉，请问这段代码可以写到一起吗~再次感谢~

沈熠 · 发表于 2022-8-2 11:17

413191246se 发表于 2022-8-1 18:28
* 单个文件处理代码：

感谢大神3次出手相助~，我还想把除了文件名称、编号以及发放部门的表格之外的内容都删掉，请问这段代码可以写到一起吗~再次感谢~

413191246se · 发表于 2022-8-2 20:13

Sub DocProcess802()
Dim s$, t$
With ActiveDocument
With .Sections(1).Headers(1).Range.Tables(1).Range
t = Replace(.Cells(4).Range.Text & " + " & .Cells(2).Range.Text, Chr(7), "")
End With
With .Tables(1).Range
s = .Cells(.Cells.Count).Range.Text
s = Replace(t & " + " & s, vbCr, "")
.Cells(.Cells.Count).Range.Text = s
.Rows.WrapAroundText = False
End With
.Range(.Tables(1).Range.Next.Start, .Content.End).Delete
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 如何用VBA批量复制页眉表格内容到正文中