I hope my first post will be OK and not offend (I've tried to follow the guide and done a lot of searching).
I've modified the below code from Greg Maxey (https://gregmaxey.com/word_tip_pages/word_fields.html) to update links in my Word document to an Excel workbook. It seems to be the most used code for this purpose. The reason I changed his code was to try to do away with the need to have a counter variable like i, and using a For i = 1 to .Fields.Count Then... Next i structure.
When I run it as is, it gets stuck in a loop only updating the first field in the Word document. To see this, I put in the Debug.Print wrdField.Index line. It repeatedly outputs 1, so it is not moving to the Next wrdField as I expect (the code actually just used Next, but it's the same result if I use Next wrdField).
When I comment out .AutoUpdate = False, it works properly:
Public Sub UpdateExternalLinksToCurrentFolder()
Dim wrdDocument As Word.Document
Dim wrdField As Word.Field
Dim strCurrentLinkedWorkbookPath, strNewLinkedWorkbookPath As String
Dim strCurrentLinkedWorkbookName, strNewLinkedWorkbookName As String
Dim strCurrentLinkedWorkbookFullName, strNewLinkedWorkbookFullName As String
Dim strThisDocumentPath As String
'On Error GoTo ErrorHandler_UpdateExternalLinksToCurrentFolder
Application.ScreenUpdating = False
Set wrdDocument = ActiveDocument
strThisDocumentPath = wrdDocument.Path & Application.PathSeparator
strNewLinkedWorkbookPath = strThisDocumentPath
With wrdDocument
For Each wrdField In .Fields
With wrdField
If .Type = wdFieldLink Then
With .LinkFormat
Debug.Print wrdField.Index
strCurrentLinkedWorkbookPath = .SourcePath & Application.PathSeparator
strCurrentLinkedWorkbookName = .SourceName
strNewLinkedWorkbookName = strCurrentLinkedWorkbookName
strNewLinkedWorkbookFullName = strNewLinkedWorkbookPath & strNewLinkedWorkbookName
.AutoUpdate = False
End With
.Code.Text = VBA.Replace(.Code.Text, Replace(strCurrentLinkedWorkbookPath, "\", "\\"), Replace(strNewLinkedWorkbookPath, "\", "\\"))
End If
End With
Next
End With
Set wrdDocument = Nothing
Application.ScreenUpdating = True
Exit Sub
Can anyone tell my why it's behaving this way? When I set .AutoUpdate = False, am I changing something about the link field or doing something to the Word document that causes the .wrdField.Index to reset to 1? I can't find anything online documenting this behavior and it's driving me nuts.
Behind the scenes, what's happening is that Word recreates the content and the field. The orginal linked content is removed and new content inserted. So that essentially destroys the field and recreates it. A user won't notice this, but VBA does.
When dealing with a loop situation that uses an index and the looped items are being removed, it's therefore customary to loop backwards (from the end of the document to the beginning). Which cannot be done with For...Each.
Related
i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub
Couldn't find the answer I was looking for.
I want to get the current page number String including its format.
For example: Some sections may have chapter identifier (1-1), some are in Roman style, etc..
My hope was to get the selection of the specific footer, then loop through the fields and get the Page field data (Output is the String I want).
So far as I can see, there is no option to loop through the footers of a given section, just get the general template and try working with it.
I'm aware of wdActiveEndAdjustedPageNumber from Selection.Range.Information, but it just gives me partial information.
Am I wrong? Is there a way to work with a specific footer I choose?
If not, can you guide me how to get the following data:
Closest chapter number value
Getting the page number value of a special format such as Roman, Alphabetical font (Meaning applying the page format on the wdActiveEndAdjustedPageNumber)
Thanks.
Edit for clarification:
In my word template, the Heading 1 style creates the following header: Chapter 1, followed by Chapter 2 and so on.
In page number format, there is an option to include the current Chapter value to the page number.
For example: Assuming the following setup
will result with these pages in the { PAGE } field: 1-1, 1-2, 1-3, ...
My goal is to somehow get this entire "value" for a specific page footer.
Here is a code snippet which won't work properly:
Sub getPageFieldInFooter()
' get current section number
Dim sectionNum As Integer
sectionNum = Selection.Range.Information(wdActiveEndSectionNumber)
'select first page footer, loop through its fields and find Page field
ActiveDocument.Sections(sectionNum).Footers(wdHeaderFooterPrimary).Range.Select
Dim f As Field
For Each f In Selection.Fields
If f.Type = wdFieldPage Then
' do something with the page data
MsgBox f.Data
End If
Next f
End Sub
The output of such a method is '1-1'
The reason it won't work is because it can retrieve the first page only (or the second using wdHeaderFooterEvenPages).
Same goes for Roman number format, or any other from that list.
For the following page number settings, I wish to get the "value" in a specific footer.
The code above will return the values for first or second page, and that's it.
Is there a way to access any footer in the document and perform my code example?
If not, how can I get the page number "value" for any footer I choose?
Hope this is clearer.
The following is working for me, although I'm not certain how reliable it is. Apparently, if I query the Footer (or Header) of the current selection in the document it will return the information for the Footer (or Header) of that page.
Things get very complicated as soon as you start working with multiple sections and Different First Page. I've done some testing for that in the code below, but I wouldn't swear it's "production code". However, it should give you a starting place.
Sub GetFormattedPageNumberFromSelection()
Dim sel As word.Selection
Dim sec As word.Section
Dim r As word.Range, rOriginal As word.Range
Dim fld As word.Field
Dim secCurrIndex As Long
Dim sNoPageNumber As String
Set sel = Selection
If Not sel.InRange(sel.Document.content) Then Exit Sub
Set sec = sel.Sections(1)
If Not sec.Footers(wdHeaderFooterFirstPage).exists Then
Set r = sec.Footers(wdHeaderFooterPrimary).Range
Else
Set r = sel.Range
Set rOriginal = r.Duplicate
secCurrIndex = sec.index
If secCurrIndex <> 1 Then
sel.GoToPrevious wdGoToPage
If sel.Sections(1).index = secCurrIndex Then
Set r = sec.Footers(wdHeaderFooterPrimary).Range
Else
Set r = sec.Footers(wdHeaderFooterFirstPage).Range
End If
rOriginal.Select 'return to original selection
ElseIf r.Information(wdActiveEndPageNumber) = 1 Then
Set r = sec.Footers(wdHeaderFooterFirstPage).Range
Else
Set r = sec.Footers(wdHeaderFooterPrimary).Range
End If
End If
For Each fld In r.Fields
sNoPageNumber = "No page number"
If fld.Type = wdFieldPage Then
Debug.Print fld.result
sNoPageNumber = ""
Exit For
End If
Next
If Len(sNoPageNumber) > 0 Then Debug.Print sNoPageNumber
End Sub
...and sometimes we don't see the simplest way.
Insert a Page field at the current selection, read the result, then delete it again:
Sub GetFormattedPageNumberFromSelection2()
Dim rng As word.Range
Dim fld As word.Field
Set rng = Selection.Range
Set fld = rng.Fields.Add(rng, wdFieldPage)
Debug.Print fld.result
fld.Delete
End Sub
What you haven't told us is how you're 'choosing' the page you want the reference for. Assuming it's based in whatever page is selected/displayed, you could use something like the following for a page header:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, Fld As Field
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
For Each Fld In Selection.HeaderFooter.Range.Fields
If Fld.Type = wdFieldPage Then
MsgBox Fld.Result
Exit For
End If
Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Application.ScreenUpdating = True
End Sub
Unfortunately, wdSeekCurrentPageFooter returns the next page's footer!, so you can't use that for the current footer. The following, however, should work wherever the PAGE # field is located:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, Fld As Field, bExit As Boolean: bExit = False
With ActiveWindow.ActivePane.Pages(Selection.Information(wdActiveEndAdjustedPageNumber))
For i = 1 To .Rectangles.Count
With .Rectangles(i).Range
For Each Fld In .Fields
If Fld.Type = wdFieldPage Then
MsgBox Fld.Result
bExit = True: Exit For
End If
Next
End With
If bExit = True Then Exit For
Next
End With
Application.ScreenUpdating = True
End Sub
So I have 4 documents, 3 excel spreadsheets and 1 document. All four are in the same directory "test." All four will always remain in the same directory no matter what. However, the goal of the document is to build a report out of the three spreadsheets for multiple properties. This means that the paths would be different for every different computer that it was used on. I want a macro that will auto-update the LINK fields with the current path but I'm running into some trouble.
So far I have
SendKeys "%{F9}"
Dim path As String
path = ActiveDocument.path
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "C:\\Users\\Gianni\\Desktop"
.Replacement.Text = path
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
SendKeys "%{F9}"
There are two problems with this from what I can tell. If I just view the fields manually and run the code without the first SendKeys command, the find & replace works. With the first SendKeys command, however, the code doesn't replace the text with the new path. Still, the path that pastes ends up breaking the link anyway. How do I go about fixing these?
Often, it's better in Word to work with the underlying object model of a Word document, than trying to reproduce exactly what you do as a user. Understanding how Word works, from a user point-of-view is very important and there are many things you you're able to do by converting those steps into a macro. But digging into the object model is generally faster and more accurate.
Changing a LINK field code is one of those things - and like many things, there's more than one way to go about it. Here are two possibilities.
The first is close to how you're approaching it, by manipulating the field code. Note that it's not necessary, using VBA, to actually display the field code. The object model lets you manipulate it "behind the scenes".
This procedure loops all the Fields in the document, checks whether each is a LINK field. If it is, the alternate path is substituted in the field code for the original path using the VBA Replace function, then this is written to the field code.
'Assumes the linked Excel workbook is an inline shape
Sub ChangePathInLinkField()
Dim doc As word.Document
Dim fld As word.Field
Dim strSearchPath As String
Dim strReplacePath As String
Dim strNewFieldCode As String
Set doc = ActiveDocument
strSearchPath = "C:\\Users\\[user name]\\Documents\\SampleChart.xlsx"
strReplacePath = "C:\\Test\\SampleChart.xlsx"
For Each fld In doc.Fields
If fld.Type = wdFieldLink Then
strNewFieldCode = Replace(fld.code.Text, strSearchPath, strReplacePath)
fld.code.Text = strNewFieldCode
End If
Next
doc.Fields.Update
End Sub
The second procedure shows how the link path can be changed for Shapes as well as InlineShapes (if you have a Shape you can't see the LINK field). It can also be used only on InlineShapes, of course. This loops the collection, checks whether the object is a linked OLE object and, if it is, changes the path.
Which one to use will depend on your situation - test them both and decide based on that.
'Alternate: works with OLE object
Sub ChangePathInLinkedObject()
Dim doc As word.Document
Dim ils As word.InlineShape
Dim shp As word.Shape
Dim strReplacePath As String
Dim i As Long
Set doc = ActiveDocument
strReplacePath = "C:\Users\Cindy Meister\Documents\SampleChart.xlsx"
strReplacePath = "C:\Test\SampleChart.xlsx"
'For Each doesn't work because updating the field
'destroys the object, so it loops over the same object
'For this reason it's also necessary to work backwards through the document
For i = doc.InlineShapes.Count To 1 Step -1
Set ils = doc.InlineShapes(i)
If ils.Type = wdInlineShapeLinkedOLEObject Then
ils.LinkFormat.SourceFullName = strReplacePath
ils.LinkFormat.Update
End If
Next
For i = doc.shapes.Count To 1 Step -1
Set shp = doc.shapes(i)
If shp.Type = msoLinkedOLEObject Then
shp.LinkFormat.SourceFullName = strReplacePath
shp.LinkFormat.Update
End If
Next
End Sub
Instead of using SendKeys you can show field codes with:
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
and to show field values
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
That may help with your first problem.
To see how to implement relative paths in Word, check out the solution I've posted at:
http://windowssecrets.com/forums/showthread.php/154379-Word-Fields-and-Relative-Paths-to-External-Files
Since you're working with LINK fields, you'll need the macro solution there.
I've come here for plenty of advice on how to develop VBScript and VBA applications using Excel, but now I've been faced with a new challenge: develop a VBScript/VBA application for Word.
I know, in Excel, if I wanted to type "my name" in cell B3, I would type this:
Range("B3").Value = "my name"
I need to be able to locate where a name and address for a formal letter would be entered, as well as today's date, and my initials as a signature.
I thought I might be able to find VBScript/VBA programming for Word on the internet like I did for Excel, but it seems like working with Word is not as popular. If anyone has any snippets to get me started, or a really good link to a site on the internet where I can do the coding myself, it would be greatly appreciated.
UPDATE
Here is the code I'm working with at the moment:
Public Sub WordVbaDemo()
Dim doc As Document: Set doc = ActiveDocument ' Or any other document
DateText = doc.Range(doc.Paragraphs(1).Range.End - 20, doc.Paragraphs(1).Range.End - 18).Text
End Sub`
I need the code to work for a formal letter where the date is right-justified:
Date: November 7th, 2016
The code I have above will copy the date text after "Date: ". The original template doesn't have a prefilled date. If I enter one, the "Member: " field looks offset like this:
Date: November 7th, 2016
Member:
I'm looking for a way to enter text without upsetting the alignment.
UPDATE 2
I forgot to mention this has to work as an external script. This means, if I were to open NotePad and create a script that would fill out a letter in a Word document, that is how it should work. I do apologize for this...got ahead of myself and forgot that detail.
UPDATE 3
I'm using the following code derived from code I use to find any open Internet Explorer windows. I know IE and Word are two different things, but I was hoping I could use Shell to find the Word doc and be able to manipulate the content.
Dim WinDoc, Window, TitleFound
Dim WShell, objShell
Function Check_Document()
On Error Resume Next
Set WShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
On Error GoTo 0
Window = "non-member template.docx" 'Tried this without the .docx and failed
TitleFound = False
For Each WinDoc In objShell.Windows()
If Err.Number = 0 Then
If InStr(WinDoc.Document.Title, (Window)) Then
Set objWord = WinDoc
TitleFound = True
Exit For
End If
End If
Next
If TitleFound = False Then
MsgBox "Word doc not found"
Else
MsgBox "Found Word doc!!"
End If
End Function
I was in a similar boat about 6 months ago. I had done VBA in Excel, but was asked to do some more in Word. The thing about Word VBA is that there are far fewer reasons to need to automate a Word document than an Excel document. From what I've gathered, most situations involve creating legal documents.
I've come a long way and I do have a number of sites bookmarked that I'll dig further into for you.. but this one is a quickstart to using VBA in Word.
http://word.mvps.org/faqs/MacrosVBA/VBABasicsIn15Mins.htm
But one pointer: consider if the document layout is going to be structured or not.(It wasn't clear to me in your question). If the layout is going to be structured, where you know exactly where everything is going, you might want to use bookmarks. Otherwise, you may consider the paragraphs method as indicated by z32a7ul.
My project uses UserForms as input. It's been a real challenge at times, but by using Userforms with Bookmarks, I'm able to allow the user to navigate back and forth in the userForms as well as re-run the macro (assuming they have not deleted required bookmarks).
Of course, take this with a grain of salt since I'm still learning as well. For what it's worth, I've also had the added challenge of making this all work on the Mac platform.
As a starting point:
Public Sub WordVbaDemo()
Dim doc As Document: Set doc = ActiveDocument ' Or any other document
' doc.Paragraphs(2).Range.Text = "Error if the document is empty (there is no second paragraph)."
doc.Paragraphs(1).Range.Text = "First paragraph overwritten." & vbCrLf
doc.Paragraphs(2).Range.Text = "Now I can write to Paragraph 2." & vbCrLf
doc.Paragraphs.Add(doc.Paragraphs(2).Range).Range.Text = "Inserted between Paragraph 1 and 2." & vbCrLf
doc.Range(doc.Paragraphs(3).Range.End - 3, doc.Paragraphs(3).Range.End - 2).Font.StrikeThrough = True
doc.Range(doc.Paragraphs(3).Range.End - 2, doc.Paragraphs(3).Range.End - 2).Text = 3
doc.Range(doc.Paragraphs(3).Range.End - 3, doc.Paragraphs(3).Range.End - 2).Font.StrikeThrough = False
With doc.Tables.Add(doc.Range(doc.Range.End - 1), 2, 2)
.Cell(1, 1).Range.Text = "Header1"
.Cell(1, 2).Range.Text = "Header2"
.Cell(2, 1).Range.Text = "Value1"
.Cell(2, 2).Range.Text = "Value2"
Dim varBorder As Variant: For Each varBorder In Array(wdBorderTop, wdBorderBottom, wdBorderLeft, wdBorderRight, wdBorderVertical, wdBorderHorizontal)
.Borders(varBorder).LineStyle = wdLineStyleSingle
Next varBorder
.Rows(1).Shading.BackgroundPatternColor = RGB(123, 45, 67)
.Rows(1).Range.Font.Color = wdColorLime
End With
End Sub
First of all, I want to thank everyone who replied. You helped guide me to my solution. Below is the code I came up with to locate where a name and address for a formal letter would be entered, as well as today's date, and my initials as a signature.
Function Check_Document()
On Error Resume Next
Set objWord = CreateObject("Word.Application")
On Error GoTo 0
objWord.Visible = True
Set objDoc = objWord.Documents.Open("C:\Users\lpeder6\Desktop\myDoc.docx")
Set objRange = objDoc.Bookmarks("TodaysDate").Range
objRange.Text = "November 11th, 2016"
Set objRange = objDoc.Bookmarks("Name").Range
objRange.Text = "John Smith"
Set objRange = objDoc.Bookmarks("Address").Range
objRange.Text = "123 N. Anywhere Ave."
Set objRange = objDoc.Bookmarks("City").Range
objRange.Text = "Northwoods" & ", "
Set objRange = objDoc.Bookmarks("State").Range
objRange.Text = "MN"
Set objRange = objDoc.Bookmarks("Zip").Range
objRange.Text = "55555"
Set objRange = objDoc.Bookmarks("Init").Range
objRange.Text = "JS"
End Function
The bookmarks are preset within the document so the code has something to look for. Anything within these fields gets replace with the objRange.Text. Variables could be used to store information if this was external coding and the variables would contain data from arguments sending the data.
I hope this code helps others as much as it helped me. Thanks again to everyone who offered me ideas that got me here.
Disclaimer: It's been a few years since I worked (a lot) with VBA, so this might be an issue caused by confusing myself with what is essentially a very different language from what I usually deal with.
So; I've got a workbook (Excel 2010) with multiple sheets (20+), most of whom are multi-page. To make things easier when printing everything, I want to add some sheet-specific headers with amongst others the name of the sheet, number of pages and so on.
I've written a tiny function that should (in theory) do this for me by iterating over all the sheets setting the header. However, for some reason it only works if the header is empty; if it already has a value it refuses to overwrite for some unknown reason.
Dim sheetIndex, numsheets As Integer
sheetIndex = 1
numsheets = Sheets.Count
' Loop through each sheet, but don't set any of them to active
While sheetIndex <= numsheets
Dim sheetname, role, labeltext As String
sheetname = Sheets(sheetIndex).name
role = GetRole(mode)
labeltext = "Some text - " & sheetname & " - " & role
With Sheets(sheetIndex).PageSetup
.LeftHeader = labeltext
.CenterHeader = ""
.RightHeader = "Page &[Page] / &[Pages]"
.LeftFooter = "&[Date] - &[Time]"
.CenterFooter = ""
.RightFooter = "Page &P / &N"
End With
sheetIndex = sheetIndex + 1
Wend
I found a solution that seems to work for replacing text. For whatever reason, in the macro, you need to include the header/footer format character codes in order for it to work properly.
This code worked to replace existing header text with new information:
Sub test()
Dim sht As Worksheet
Set sht = Worksheets(1)
sht.PageSetup.LeftHeader = "&L left text"
sht.PageSetup.CenterHeader = "&C center Text"
sht.PageSetup.RightHeader = "&R right text"
End Sub
Without the &L, &C, and &R codes before the text, I could not get it to work.
Some interesting behavior I found is that if you use the following code:
.CenterHeader = "&L some text"
it will actually put the some text in the LeftHeader position. This led me to believe that the formatting codes were very important.
The line Application.PrintCommunication = False (which is added by the macro recorder) before doing PageSetup screws up the formating via VBA.
If your code has got this line in it, try removing it. That solved my problem with setting the header and footer via VBA.
I've read StackOverflow for years and this is the first time I've actually been able to post a solution ... hope it helps someone!! Also, you need to remember, I am a CPA not a programmer ;-)
I am reading some values from the ActiveSheet to populate the header. The application is a tax election that will be sent with a tax return so it must have the taxpayer's name and social security number at the top.
Sub PrintElection()
' Print preview the MTM Election
If Range("Tax_Year").Value = Range("First_MTM_year").Value Then
ActiveSheet.PageSetup.LeftHeader = Format(Worksheets("Election").Range("Taxpayer_Name").Value)
ActiveSheet.PageSetup.RightHeader = Format(Worksheets("Election").Range("Taxpayer_SSN").Value)
ActiveWindow.SelectedSheets.PrintPreview
Else
MsgBox "The 'Effective For Tax Year' date must EQUAL the 'First MTM year' date", vbOKOnly, "Check Years"
Sheets("Roadmap").Select
Range("First_MTM_year").Select
End If
End Sub
It checks to see if the Mark-to-Market election year is the same as the election form then formats the election page.
I split the sheet print setup into 2 loops. First loop with Application.PrintCommunication = False I run the non-header/footer setup. I then set Application.PrintCommunication = True and run the header/footer setup in a second loop. Appears to run faster than in XL2003, and applies the header/footer correctly. Until MS fixes this bug, that works fine for me.