如何遍历页眉页脚，取消链接到前一页。并在横向页面在左边插入页码？

小声说话666 · 发表于 2021-2-17 14:31

Dim oDoc As Document
Set oDoc = Word.ActiveDocument
Dim oSec As Section
With oDoc
      '先遍历所有的节对象
      For Each oSec In .Sections
         With oSec
            With .Headers(wdHeaderFooterPrimary)
            .LinkToPrevious = False '对页眉执行相关的操作
            End With
            With .Footers(wdHeaderFooterPrimary)
      .LinkToPrevious = False    '对页脚执行相关的操作
            End With
         End With
      Next
End With

网上找来一段代码，自己修改了一下，链接到上一节好象不能全部取消。请高手们看一下。

413191246se · 发表于 2021-2-18 12:22

楼主，你提供的附件，昨晚我 2 个半小时没搞定！刚才我又想了一下，按照你的要求，可以不用代码，假设在 Word 2019 中，点击：插入选项卡——页脚——编辑页脚——光标定位在横向页码上，再点击：开始选项卡——左对齐——OK！就这么简单！我觉得就达到了你的目的。用代码反而不易搞定。

ming0018 · 发表于 2021-2-18 15:27

有奇偶不同的时候　要区别处理

小声说话666 · 发表于 2021-2-18 17:04

本帖最后由小声说话666 于 2021-2-18 18:59 编辑

413191246se 发表于 2021-2-18 12:22
楼主，你提供的附件，昨晚我 2 个半小时没搞定！刚才我又想了一下，按照你的要求，可以不用代码，假设在 Wo ...

由于审核重复回贴了。。

小声说话666 · 发表于 2021-2-18 17:09

413191246se 发表于 2021-2-18 12:22
楼主，你提供的附件，昨晚我 2 个半小时没搞定！刚才我又想了一下，按照你的要求，可以不用代码，假设在 Wo ...

手工操作我录了一个视频，录制宏不能重动作。我的思路是反向遍历所有页眉页脚断开链接到上一页。删除所有横向页码，再在所有横向页插入页码。
插入横向页码视频请下载观看（因为文件分奇偶页，须把单页补全为奇偶页全有才能操作，要不会出现还有页眉页脚链接上一页的情况）：下载:https://wwa.lanzous.com/idmY4lt1uab 密码:hue3

另：我使用的是WPS2016 没有安装WORD

小声说话666 · 发表于 2021-2-18 17:16

ming0018 发表于 2021-2-18 15:27
有奇偶不同的时候　要区别处理

就是，奇偶页和首页不同，还有插入目录后节不同，真让人头大。

ming0018 · 发表于 2021-2-18 17:29

小声说话666 发表于 2021-2-18 17:16
就是，奇偶页和首页不同，还有插入目录后节不同，真让人头大。

弄清楚原理　才能真正玩转word

19820713chen · 发表于 2021-2-24 17:13

是要这样的效果吗？

19820713chen · 发表于 2021-2-24 17:33

Sub 插入页码_外侧1()
Dim s As Section
Dim n As String
Dim asection As Section
Application.ScreenUpdating = False '关闭屏幕刷新
On Error Resume Next '设置错误处理
Dim 节 As Section
Dim 总节数 As Long, 计数器 As Long
If Documents.Count <> 0 Then
总节数 = ActiveDocument.Sections.Count
Else
Exit Sub '如果没有打开文档直接退出
End If
For 计数器 = 2 To 总节数
With ActiveDocument
If .Sections(计数器).PageSetup.Orientation <> .Sections(计数器 - 1).PageSetup.Orientation Or wdOrientLandscape Then
.Sections(计数器).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
.Sections(计数器).Footers(wdHeaderFooterEvenPages).LinkToPrevious = False
'如果本节页面方向和前节页面方向不同，则关闭本节同前开关设置
End If
End With
Next 计数器 '取消所有节的同前开关设置
For Each asection In ActiveDocument.Sections
With asection.Headers(wdHeaderFooterPrimary)
.Range.Delete
.Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
End With
Next
'删除页脚
For Each asection In ActiveDocument.Sections
With asection.Footers(wdHeaderFooterPrimary)
.Range.Delete
.Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
End With
With asection.Footers(wdHeaderFooterEvenPages)
.Range.Delete
.Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
End With
Next
n = InputBox("请输入章节号(不需要章节请输入一个空格）： " & vbCr & " ")
For Each s In ActiveDocument.Sections
s.Footers(1).Range.Delete
With s.Footers(1).Range.Sections(1).Headers(1).PageNumbers
.NumberStyle = wdPageNumberStyleArabic
.HeadingLevelForChapter = 0
.IncludeChapterNumber = False
.ChapterPageSeparator = wdSeparatorHyphen
.RestartNumberingAtSection = False
.StartingNumber = 0
End With
s.Footers(1).PageNumbers.Add 4, True
With s.Footers(wdHeaderFooterPrimary).Range.Frames(1).Range
.Select
With Selection
.InsertBefore n
With .Font
.Name = "宋体"
.Name = "Times New Roman"
.Size = 9
End With
.ParagraphFormat.CharacterUnitRightIndent = 1.5
End With
End With
With s.Footers(wdHeaderFooterEvenPages).Range.Frames(1).Range
.Select
With Selection
.InsertBefore n
With .Font
.Name = "宋体"
.Name = "Times New Roman"
.Size = 9
End With
.ParagraphFormat.CharacterUnitRightIndent = 1.5
End With
End With
Next
ActiveWindow.ActivePane.Close
ActiveWindow.View.Type = wdPrintView
For 计数器 = 2 To 总节数
ActiveDocument.Sections(计数器).PageSetup.OddAndEvenPagesHeaderFooter = True
If ActiveDocument.Sections(计数器).PageSetup.Orientation = wdOrientLandscape Then
'如果是横向页面，则进行调整
With ActiveDocument.Sections(计数器).Footers(wdHeaderFooterPrimary).Range.Frames(1)
.Width = CentimetersToPoints(0.42)
.HeightRule = wdFrameAtLeast
.Height = CentimetersToPoints(1.05)
.HorizontalPosition = MillimetersToPoints(16) '页码距短边15毫米，左下位置
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.VerticalPosition = MillimetersToPoints(188)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.HorizontalDistanceFromText = MillimetersToPoints(0)
.VerticalDistanceFromText = MillimetersToPoints(0)
.Range.Orientation = wdTextOrientationDownward '调整页码文字方向
End With
With ActiveDocument.Sections(计数器).Footers(wdHeaderFooterEvenPages).Range.Frames(1)
.Width = CentimetersToPoints(0.42)
.HeightRule = wdFrameAtLeast
.Height = CentimetersToPoints(1.05)
.HorizontalPosition = MillimetersToPoints(16) '页码距短边15毫米，右下位置
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.VerticalPosition = MillimetersToPoints(15)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.HorizontalDistanceFromText = MillimetersToPoints(0)
.VerticalDistanceFromText = MillimetersToPoints(0)
.Range.Orientation = wdTextOrientationDownward '调整页码文字方向
End With
End If
ActiveDocument.Sections(计数器).Headers(wdHeaderFooterPrimary) _
.Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone '用于防止页眉出现横线
ActiveDocument.Sections(计数器).Headers(wdHeaderFooterEvenPages) _
.Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With ActiveDocument.Sections(计数器).Footers(wdHeaderFooterEvenPages).Range.Font
.Name = "Times New Roman"
.Size = 9
End With
Next 计数器
Application.ScreenUpdating = True '恢复屏幕刷新
End Sub

复制代码

小声说话666 · 发表于 2021-2-24 23:42

19820713chen 发表于 2021-2-24 17:13
是要这样的效果吗？

公文一字线的效果

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

[求助] 如何遍历页眉页脚，取消链接到前一页。并在横向页面在左边插入页码？