Excel headers/footers won't change via VBA unless blank - vba

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.

Related

What does a hyperlink range.start and range.end refer to?

I'm trying to manipulate some text from a MS Word document that includes hyperlinks. However, I'm tripping up at understanding exactly what Range.Start and Range.End are returning.
I banged a few random words into an empty document, and added some hyperlinks. Then wrote the following macro...
Sub ExtractHyperlinks()
Dim rHyperlink As Range
Dim rEverything As Range
Dim wdHyperlink As Hyperlink
For Each wdHyperlink In ActiveDocument.Hyperlinks
Set rHyperlink = wdHyperlink.Range
Set rEverything = ActiveDocument.Range
rEverything.TextRetrievalMode.IncludeFieldCodes = True
Debug.Print "#" & Mid(rEverything.Text, rHyperlink.Start, rHyperlink.End - rHyperlink.Start) & "#" & vbCrLf
Next
End Sub
However, the output between the #s does not quite match up with the hyperlinks, and is more than a character or two out. So if the .Start and .End do not return char positions, what do they return?
This is a bit of a simplification but it's because rEverything counts everything before the hyperlink, then all the characters in the hyperlink field code (including 1 character for each of the opening and closing field code braces), then all the characters in the hyperlink field result, then all the characters after the field.
However, the character count in the range (e.g. rEverything.Characters.Count or len(rEverything)) only includes the field result if TextRetrievalMode.IncludeFieldCodes is set to False and only includes the field code if TextRetrievalMode.IncludeFieldCodes is set to True.
So the character count is always smaller than the range.End-range.Start.
In this case if you change your Debug expression to something like
Debug.Print "#" & Mid(rEverything.Text, rHyperlink.Start, rHyperlink.End - rHyperlink.Start - (rEverything.End - rEverything.Start - 1 - Len(rEverything))) & "#" & vbCrLf
you may see results more along the lines you expect.
Another way to visualise what is going on is as follows:
Create a very short document with a piece of text followed by a short hyperlink field with short result, followed by a piece of text. Put the following code in a module:
Sub Select1()
Dim i as long
With ActiveDocument
For i = .Range.Start to .Range.End
.Range(i,i).Select
Next
End With
End Sub
Insert a breakpoint on the "Next" line.
Then run the code once with the field codes displayed and once with the field results displayed. You should see the progress of the selection "pause" either at the beginning or the end of the field, as the Select keeps "selecting" something that you cannot actually see.
Range.Start returns the character position from the beginning of the document to the start of the range; Range.End to the end of the range.
BUT everything visible as characters are not the only things that get counted, and therein lies the problem.
Examples of "hidden" things that are counted, but not visible:
"control characters" associated with content controls
"control characters" associated with fields (which also means hyperlinks), which can be seen if field result is toggled to field code display using Alt+F9
table structures (ANSI 07 and ANSI 13)
text with the font formatting "hidden"
For this reason, using Range.Start and Range.End to get a "real" position in the document is neither reliable nor recommended. The properties are useful, for example, to set the position of one range relative to the position of another.
You can get a somewhat more accurate result using the Range.TextRetrievalMode boolean properties IncludeHiddenText and IncludeFieldCodes. But these don't affect the structural elements involved with content controls and tables.
Thank you both so much for pointing out this approach was doomed but that I could still use .Start/.End for relative positions. What I was ultimately trying to do was turn a passed paragraph into HTML, with the hyperlinks.
I'll post what worked here in case anyone else has a use for it.
Function ExtractHyperlinks(rParagraph As Range) As String
Dim rHyperlink As Range
Dim wdHyperlink As Hyperlink
Dim iCaretHold As Integer, iCaretMove As Integer, rCaret As Range
Dim s As String
iCaretHold = 1
iCaretMove = 1
For Each wdHyperlink In rParagraph.Hyperlinks
Set rHyperlink = wdHyperlink.Range
Do
Set rCaret = ActiveDocument.Range(rParagraph.Characters(iCaretMove).Start, rParagraph.Characters(iCaretMove).End)
If RangeContains(rHyperlink, rCaret) Then
s = s & Mid(rParagraph.Text, iCaretHold, iCaretMove - iCaretHold) & "" & IIf(wdHyperlink.TextToDisplay <> "", wdHyperlink.TextToDisplay, wdHyperlink.Address) & ""
iCaretHold = iCaretMove + Len(wdHyperlink.TextToDisplay)
iCaretMove = iCaretHold
Exit Do
Else
iCaretMove = iCaretMove + 1
End If
Loop Until iCaretMove > Len(rParagraph.Text)
Next
If iCaretMove < Len(rParagraph.Text) Then
s = s & Mid(rParagraph.Text, iCaretMove)
End If
ExtractHyperlinks = "<p>" & s & "</p>"
End Function
Function RangeContains(rParent As Range, rChild As Range) As Boolean
If rChild.Start >= rParent.Start And rChild.End <= rParent.End Then
RangeContains = True
Else
RangeContains = False
End If
End Function

MS Word updating links: Why does changing a .LinkFormat property reset field Index

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.

Extracting hyperlink from a range and writing them on another range

I'm new to this site, but I have already found some nice advice on how to solve problems in VBA. Now I'm here to ask help on a sub that gives me problems with Hyperlinks.
In particular, my problem is similar to the one described in this topic:
Excel VBA Get hyperlink address of specific cell
I have a worksheet full of hyperlink, but I need to extract only the addresses present in the "H" column, starting from "H6" and writing them into the "N" column, starting from "N6".
I put down this code:
Sub EstraiIndirizzoPut()
Dim IndirizzoInternet As Hyperlink
Dim ISINs As String
i = 6
For Each IndirizzoInternet In Sheets("XXX").Range("H" & i).Hyperlinks
IndirizzoInternet.Range.Offset(0, 6).Value = IndirizzoInternet.Address
ISINs = Mid(IndirizzoInternet.Address, 78, 12)
Range("N" & i).Value = ISINs
i = i + 1
Next
End Sub
It works fine only for the first "H6" cell, but at the "Next" point, when it should read the "H7" cell, it goes instead to "End Sub", terminating the routine, altough the "H7" cell, as well many others down the column, are filled with hyperlinks (it gives me "Nothing" value).
Could you please suggest me where I get this wrong? Many thanks.
Your loop isnt set up correctly. Try it like this instead:
For i = 6 to 100
Set IndirizzoInternet = Sheets("XXX").Range("H" & i).Hyperlinks
IndirizzoInternet.Range.Offset(0, 6).Value = IndirizzoInternet.Address
ISINs = Mid(IndirizzoInternet.Address, 78, 12)
Range("N" & i).Value = ISINs
Next
How do you know when to stop the loop? Is it a preset number of rows? If it not, you will want to have something determine the last row to process and replace the 100 with that variable.

xlErrorChecks Enumeration Office 365/Excel 2016

In my current version of Excel, the enumeration of xlNumberAsText seems inconsistent with both the documentation XlErrorChecks Enumeration (Excel) and prior usage recommended on SO. It seems that particular error is Item 4; whereas previous posts about clearing this error using VBA have used a constant of 3.
Is this a bug in Excel 2016? Or am I doing something incorrectly.
Here is code demonstrating the issue. And if you examine the worksheet after running the code, it is apparent that the error is flagged, in Excel, as NumberAsText and not as Inconsistent Formula.
Option Explicit
Sub foo()
Dim I As Long
Dim B As Boolean
Dim S As String
Dim R As Range
'Save current state
B = Application.ErrorCheckingOptions.NumberAsText
'Enable
Application.ErrorCheckingOptions.NumberAsText = True
Set R = Cells(1, 1)
With R
.Clear
.NumberFormat = "#"
.Value = "1"
End With
For I = 1 To 10
S = S & vbLf & I & vbTab & R.Errors(I).Value
Next I
S = Mid(S, 2)
'Restore original state
Application.ErrorCheckingOptions.NumberAsText = B
MsgBox S
End Sub
And also, in trying to clear the error box, I must use
R.Errors(4).Ignore = True
Neither Errors(3), nor Errors(xlNumberAsText) will have any affect on the error box.
I've noted other inconsistencies with the enum and the documentation:
Inconsistent Formula: 5
Wrong Data Type: 2
I'm not going to bother to check the rest. But I am going to try to report it to MS. Thanks to those who confirmed this problem.
Followup: I reported this to MS via the Feedback option within Excel. And after this morning's update, the problem seems to have been corrected.

Manipulating content in Microsoft Word with VBScript or VBA

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.