Sub 替换页眉页脚()

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close

With ActiveWindow.ActivePane.View

.Type = wdPrintView

.SeekView = wdSeekCurrentPageHeader

Selection.WholeStory

Selection.Delete Unit:=wdCharacter, Count:=1

'Selection.TypeText Text:="这是替换后的页眉"

With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)

Set rng = .Range

rng.Text = "第 "

rng.Collapse wdCollapseEnd

'wdCollapseEnd 折叠一个代表完整段落的区域，则该区域将定位于段落结束标记之后（即下段开头）。

'但是，在该区域折叠后，可以用 MoveEnd 方法将区域回移一个字符。

ActiveDocument.Fields.Add rng, wdFieldPage, "Page"

Set rng = .Range

rng.Collapse wdCollapseEnd

rng.Text = " 页 / 共 "

rng.Collapse wdCollapseEnd

ActiveDocument.Fields.Add rng, wdFieldNumPages, "Pages"

Set rng = .Range

rng.Collapse wdCollapseEnd

rng.Text = " 页 "

.Range.Fields.Update

.Range.ParagraphFormat.Alignment = wdAlignParagraphRight

'隐藏页眉的横线；

.Range.Borders(wdBorderBottom).Visible = False

End With

'加载一图片文件作为页眉

'Selection.InlineShapes.AddPicture FileName:="F:\Website\witiso\33VBA\实例\word\top.jpg", LinkToFile:=False, SaveWithDocument:=True

'Selection.MoveLeft Unit:=wdCharacter, Count:=93, Extend:=wdExtend

'Selection.InlineShapes(1).ConvertToShape.Select

'Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(11)

'Selection.ShapeRange.Width = 481.6

'Selection.ShapeRange.ZOrder msoSendBehindText

.SeekView = wdSeekMainDocument

End With

WordBasic.ViewFooterOnly

Selection.WholeStory

Selection.Delete Unit:=wdCharacter, Count:=1

'Selection.TypeText Text:="这是替换后的页脚"

Dim GetDocName

GetDocName = Left$(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)

With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)

Set rng = .Range

rng.Text = GetDocName

rng.Collapse wdCollapseEnd

Set rng = .Range

rng.Collapse wdCollapseEnd

rng.Text = " 第 "

rng.Collapse wdCollapseEnd

ActiveDocument.Fields.Add rng, wdFieldPage, "Pages"

Set rng = .Range

rng.Collapse wdCollapseEnd

rng.Text = " 页 / 共 "

rng.Collapse wdCollapseEnd

ActiveDocument.Fields.Add rng, wdFieldNumPages, "Pages"

Set rng = .Range

rng.Collapse wdCollapseEnd

rng.Text = " 页 "

.Range.Fields.Update

.Range.ParagraphFormat.Alignment = wdAlignParagraphRight

End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

' 设置页面边距和页眉页脚边距

With ActiveDocument.PageSetup

.TopMargin = CentimetersToPoints(1.5)

.BottomMargin = CentimetersToPoints(1.7)

.LeftMargin = CentimetersToPoints(1.7)

.RightMargin = CentimetersToPoints(1.5)

.HeaderDistance = CentimetersToPoints(1)

.FooterDistance = CentimetersToPoints(1.2)

End With

ActiveWindow.ActivePane.VerticalPercentScrolled = 0

End Sub