I have tested the sample code in the corresponding MSDN article:
Sub WorkWithPages()
' Fill random data:
Range("A1", "R100").Formula = "=RANDBETWEEN(1, 100)"
Dim pgs As Pages
Set pgs = PageSetup.Pages
PageSetup.DifferentFirstPageHeaderFooter = True
' Look in the Immediate window for this output:
Debug.Print "The current sheet can be printed on " & _
pgs.Count & " page(s)."
Dim pg As Page
Set pg = pgs(1)
pg.CenterHeader.Text = "This is the first page's header"
Set pg = pgs(2)
pg.CenterFooter.Text = "This is the second page's footer"
Set pg = pgs(pgs.Count)
pg.CenterFooter.Text = "This is the last page's center footer."
pg.LeftHeader.Text = "This is the last page's header"
' Note that Excel supports only distinct headers/footers
' for the first page, so headers and footers on the second
' and other pages are combined--the last value set overwrites
' the header/footer.
' See the values in the Immediate window.
' Note that the code disregards errors that occur--attempting
' to retrieve a header/footer setting that doesn't exist raises an error:
On Error Resume Next
Debug.Print "First page (CenterHeader) : " & pgs(1).CenterHeader.Text
Debug.Print "Second page (CenterHeader): " & pgs(2).CenterHeader.Text
Debug.Print "Second page (CenterFooter): " & pgs(2).CenterFooter.Text
Debug.Print "Third page (CenterFooter) : " & pgs(3).CenterFooter.Text
Debug.Print "Last page (LeftHeader) : " & pgs(pgs.Count).LeftHeader.Text
Debug.Print "Last page (CenterFooter) : " & pgs(pgs.Count).CenterFooter.Text
' In conclusion, use the Page class to retrieve information about headers
' and footers for specific pages. Use the PageSetup object to set the headers
' and footers, as it's clearer to set them there.
End Sub
But the values output by the Debug.Print "Second page (CenterFooter): " & pgs(2).CenterFooter.Text line differ from what is expected:
Second page (CenterFooter): This is the last page's center footer
Instead of the right: Second page (CenterFooter): This is the second page's footer.
I have tried different things but all the CenterFooter keep always the last input value. How can I change this behaviour such that each page gets the exact footer I want?
There are different footers/headers configurations but none of them allows to write a different value for each page. You can write a different text for the first page and for even/uneven pages; also you can add some formatting with certain variations page to page (e.g., page number) but this is it. In Word the rules are equivalent.
Regarding the MSDN code you provided, one of its comments says:
Note that Excel supports only distinct headers/footers for the first
page, so headers and footers on the second and other pages are
combined--the last value set overwrites the header/footer.
And thus this code is actually working as expected; although it is not too clear at first sight.
I know this is resurrecting a thread from the dead, but this is actually do-able in Excel VBA. I had to figure it out as I couldn't find an acceptable solution here, so I'm leaving this for the next poor sod:
The solution is to create a subroutine to set the header and footer, and then call that routine within a loop in a different sub, calling each worksheet one at a time and managing what you want to say by variable.
So something like this:
Sub InsertQuoteHeaderAndFooter(ByVal shtHeader As Worksheet, strText$)
shtHeader.PageSetup.RightFooter = "&""Calibri"" &8 &K434643" & strTxt & " | &P of &N"
End Sub
Then call it in a For loop, modulating shtHeader and strText as needed. Hope this helps the next archaeologist.
Related
I have to format a large document for a file that has been created from a PDF which is editable, so I know all the text is there.
The document is a series of tables. In Word the tables look pretty OK, but in some cases where there should be various cells there is just 1 and tabs have been used to align the text. So, it looks good, but if any of the text gets changed then the formatting will get messed up. I would like to have a macro that looks for cells with a tab, selects the cell, counts the number of tabs, divides the cell into the right number of cells and puts the text into the right cell. For example, a cell that contains "text 1 [tab]text 2[tab]text 3" would become 3 cells "text 1", "text 2" and "text 3".
I thought Word would be able to convert the text to a table, but when the text is already in a table it doesn't work.
If anyone has any suggestions as to how I might achieve this, then they would be much appreciated!
My main issue is not knowing how to count how many tabs are in a selection.
This function will return the number of Tabs in the given string.
Function CountTabs() As Integer
Dim Txt As String
Txt = "This is" & vbTab & "a test" & vbTab & "to count Tabs"
CountTabs = Len(Txt) - Len(Replace(Txt, vbTab, ""))
End Function
The tab character - Chr(9) - is replace with nothing and the number of tabs is the difference in character count before and after the replacement. Here is an implementation of the idea in a snippet.
Private Sub Snippet()
Dim Txt As String
Dim Count As Integer
Txt = "This is" & vbTab & "a test" & vbTab & "to count Tabs"
Count = Len(Txt) - Len(Replace(Txt, vbTab, ""))
MsgBox "There are " & Count & " tabs."
End Sub
Of course, how you get the text for the variable Txt is another story and, in the context of this forum, another question. Prophylactically, I advise against using the Selection object, however. Try to use the Range object instead.
I'm making a Userform that would allow the user to changes the bounds on several charts at once. I figured out how everything should look on the first multipage, and now I'm wondering if there's any way I could add 11 pages at once to look just like the first page. My userform appears below.
I am still in the design phase for this. If there's a way to do this in the design that would be great. If there's a way to do in the Initialize sub that would also be great.
Based on your intended usage, you should be using a TabStrip instead of MultiPage being most controls within are the same layout (same amount of controls). MultiPage is intended for categorizing data with different controls on each page.
Consider this simple userform to demostrate the benefit of using TabStrip here:
The left side square is a Picture holder I have not put codes for.
With below code to handle tab changes, certain elements in the userform will change when a different Tab is clicked.
Option Explicit
Private Sub TabStrip1_Change()
Dim TabX As String
With Me.TabStrip1
TabX = .Tabs(.Value).Caption
Debug.Print "ActiveTab:", TabX
End With
Me.Frame1.Caption = "Maximum Bounds (" & TabX & ")"
Me.Frame2.Caption = "Minimum Bounds (" & TabX & ")"
Me.TextBox1.Value = "TextBox2 for " & TabX ' Forgot to change this Value to TextBox1 before the screenshot...
Me.TextBox2.Value = "TextBox2 for " & TabX
End Sub
Upon launching the userform (without setting UserForm_Initialize):
Tab2 clicked:
Tab1 clicked:
I know, there is a simple way to create running headers using STYLEREF field. Just put this:
{ STYLEREF "Heading 1" }
in the header of your document, and it works fine.
However, the problem arises when I want to match multiple heading levels. For example, on 1st page of my document I have a Heading 1 style with text Foo. And on the 2nd page of document I have Heading 2 style with text Bar.
When I'm on 1st page of document, I want to see the "Foo" in the page header. When I'm on the 2nd page, I want to see "Bar" in the page header.
It is very simple in LibreOffice, but I haven't find any "proper" way to achieve it in MS Word.
Sidenote: Well, there exists a workaround: create a character style "My headings" and apply it on the paragraph styles "Heading 1" and "Heading 2", and then use it in STYLEREF field:
{ STYLEREF "My headings" }
But it is not convenient.
I post it as StackOverflow question, because I believe, this probably could be fixed with macro.
I checked again and tried to write a macro. The macro would be possible but the difficulties starts when it comes to insert the current header style text into the page header. Since in Microsoft Word the page headers display always the same content on every page, you would need to introduce Section break on every single page. This would then allow you to have different page header content on every page. Also it's necessary to ensure that the header option connect with previous is unticked so this would work at all.
Given that it would be possible to insert the style header text of each page into the page headers of each page. It would be a really "hacky" solution and your document would be full of sections due to the section breaks. I wouldn't want to work with such a document though but that's up to you.
Here is the NOT WORKING macro I've came up with until I realized the section issue:
Sub RunningHeader()
' THIS MACRO DOES NOT WORK!
' Date: 2017.08.08
' Running header macro
' Assumes every page ends with a section break
' Supports to set running header up to level 3
Dim mPageCount As Integer
Dim mCurrentPage As Integer
Dim mPageRange As Range
Dim mSection As Section
Dim mRunningHeader As String
mPageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
' ToDo
' Ensure each page of the document ends with a "section break"
' Loop through each page.
' Idea looping through pages from:
' https://support.microsoft.com/en-us/help/269565/how-to-automate-word-to-set-and-retrieve-section-header-and-footer-inf
For mCurrentPage = 1 To mPageCount
'
If intpage <> 1 Then
' Goes to the top of the next page.
Selection.GoToNext What:=wdGoToPage
Else
' Goes to the top of the first page.
Selection.HomeKey Unit:=wdStory
End If
' Selects the content of the current page
ActiveDocument.Bookmarks("\page").Range.Select
' Get text of highest header style on current page
mRunningHeader = GetHighestHeader
' Get section of current page
Set mPageRange = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=mCurrentPage)
Set mSection = mPageRange.Sections(1)
' Disconnect page header from previous
' ToDo
' Set text into page header
' ToDo
Next
End Sub
Private Function GetHighestHeader() As String
Dim mParagraph As Paragraph
Dim mHighestHeaderText As String
Dim mHighestHeaderNumber As Integer
mHighestHeaderText = ""
For Each mParagraph In Selection.Paragraphs
If mParagraph.Style = ActiveDocument.Styles(wdStyleHeading1) Then
mHighestHeaderText = mParagraph.Range.Text
Exit For
End If
If mParagraph.Style = ActiveDocument.Styles(wdStyleHeading2) Then
If mHighestHeaderNumber < 2 Then
mHighestHeaderText = mParagraph.Range.Text
mHighestHeaderNumber = 2
End If
End If
If mParagraph.Style = ActiveDocument.Styles(wdStyleHeading3) Then
If mHighestHeaderNumber < 3 Then
mHighestHeaderText = mParagraph.Range.Text
mHighestHeaderNumber = 3
End If
End If
Next mParagraph
GetHighestHeader = mHighestHeaderText
End Function
I have a template document in Word 2013 that has the user fill in a large number of Legacy Text FormFields. At the end of the document, I've included a button which compiles the answers into a string devoid of formatting, then copies it to the clipboard.
It works, but as each FormField is read, the Word document skips back and forth between each text field and the end of the document. It's visually alarming. Is there a way to gather the values of each FormField without Word moving the cursor/focus to each field as it is read?
Here's a sample of the code:
Private Sub cmdCreateNote_Click()
Call cmdClearNote_Click
Dim ff As FormFields
Set ff = ActiveDocument.FormFields
Dim Output As String
Output = ff("ddReviewType").Result & vbCrLf
If ff("chFacInfo").Result Then
Dim FacInfo
FacInfo = Array("Field1: ", _
"Field2: ", _
"Field3: ", _
"Field4: ", _
"Field5: ")
Output = Output & "FIRST SECTION" & vbCrLf
For Index = 1 To 5
If ff("chFacInfo" & Index).Result Then
Output = Output & FacInfo(Index - 1) & ff("txFacInfo" & Index).Result & vbCrLf
End If
Next
Output = Output & vbCrLf
End If
Dim FORange As Range
Set FORange = ActiveDocument.Bookmarks("FinalOutput").Range
FORange.Text = Output
ActiveDocument.Bookmarks.Add "FinalOutput", FORange
Selection.GoTo What:=wdGoToBookmark, Name:="FinalOutput"
Selection.Copy
End Sub
It appears that every time I access ActiveDocument.FormFields( x ).Result, the document focus goes to that element, then drops back to the end of the document again.
Any pointers?
Use the Bookmark object instead of the FormField. This will allow you to access the properties without changing the screen focus. See answer on Suppress unwanted jumping/scrolling on Word 2013 VBA Script for specifics on how to do this.
ActiveDocument.Bookmarks("myFieldName").Range.Fields(1).Result
Posting comment as answer, since it worked!
Try Application.ScreenUpdating = False before going through the FormFields and then setting it to True after, in order to minimize screen updating.
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.