![]() |
#1
|
|||
|
|||
![]()
Hi,
I used the code below, provided by Macropod, to replace some documents with a new header I created. It works great, but I was wondering if there was a way to only change the first page header and leave the rest of the document unchanged. Thanks in advance. Sub UpdateDocumentHeaders() Application.ScreenUpdating = False Dim strFolder As String, strFile As String Dim wdDocTgt As Document, wdDocSrc As Document Dim Sctn As Section, HdFt As HeaderFooter strFolder = GetFolder If strFolder = "" Then Exit Sub Set wdDocSrc = ActiveDocument strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" If strFolder & "" & strFile <> wdDocSrc.FullName Then Set wdDocTgt = Documents.Open(FileName:=strFolder & "" & strFile, _ AddToRecentFiles:=False, Visible:=False) With wdDocTgt For Each Sctn In .Sections 'For Headers For Each HdFt In Sctn.Headers With HdFt If .Exists Then If Sctn.Index = 1 Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString ElseIf .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString End If End If End With Next 'For footers For Each HdFt In Sctn.Footers With HdFt If .Exists Then If Sctn.Index = 1 Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString ElseIf .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(HdFt.Index).Range. FormattedText .Range.Characters.Last = vbNullString End If End If End With Next Next .Close SaveChanges:=True End With End If strFile = Dir() Wend Set wdDocSrc = Nothing: Set wdDocTgt = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder( 0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
troyw | Word VBA | 8 | 05-05-2021 07:17 PM |
![]() |
nmkhan3010 | Word VBA | 1 | 02-26-2020 04:11 PM |
![]() |
Edszx | Word VBA | 2 | 05-27-2019 11:16 PM |
![]() |
laurieli | Office | 7 | 01-17-2016 08:56 AM |
Batch edit mail merge macros? | kbash | Word | 0 | 04-30-2014 08:32 AM |