Good Day! I have a Word Document and a macro that takes content of that document and inserts it into another Document(with all boundaries, frames etc.), Basically unorganized into organized document.
I would like to check the first page of a section (and any section) and see if any table is present if so, exit the loop, and just readjust the page accordingly with our country document standards.
I have done mostly without checking a table on the first page of a new section.
If objSection.Index = 1 Then 'the first section
'I need to check if there is a table on the first page of a section
Checking page size and orientation for the first Section.'(this is done)
ElseIf objSection.Index > 1 Then 'other sections
'practically the same thing, checking if a table exists on the first page of a section
Checking page size and orientation for all other Sections.'(this is also done)
End If
Something like the following should get you there.
Function TableInFirstPageOfSection(sec As Section) As Boolean
Dim secRange As Range, secStart As Long
Dim tblRange As Range, tblStart As Long
TableInFirstPageOfSection = False
Set secRange = sec.Range
secRange.Collapse wdCollapseStart
secStart = secRange.Information(wdActiveEndPageNumber)
If sec.Range.Tables.Count > 0 Then
Set tblRange = sec.Range.Tables(1).Range
tblRange.Collapse wdCollapseStart
tblStart = tblRange.Information(wdActiveEndPageNumber)
If tblStart = secStart Then TableInFirstPageOfSection = True
End If
End Function
Related
I'm attempting to write a macro in Word that inserts a marker at the beginning of each page in tiny font so it doesn't bump any text forward to the next page. (I then output the document to HTML and do some additional processing of the markers there in Javascript.)
I have basically figured out the script to do that:
Sub Test()
Dim PageCounter As Long
Dim FirstPageInput As String
Dim PageFirstWordRange As Range
Dim InsertWord As String
FirstPageInput = InputBox("What is the initial page number for this article?", "First Page Number?")
For PageCounter = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
Set PageFirstWordRange = ActiveDocument.Range.GoTo(wdGoToPage, wdGoToAbsolute, PageCounter)
'If this is the first page, add the initial page number. Otherwise, just insert a marker.'
If PageCounter = 1 Then
InsertWord = "!#" + FirstPageInput + "#! "
PageFirstWordRange.InsertBefore (InsertWord)
Else
'PageFirstWordRange.MoveEnd wdCharacter, -1'
InsertWord = " !##! "
PageFirstWordRange.InsertAfter (InsertWord)
End If
'Select the word we just inserted, and change its size to 1'
With PageFirstWordRange.Font
.Size = 1
End With
Next
End Sub
The issue is that there are sometimes pages and pages filled up with footnotes. Because the script tries to find the first word on each page, it ends up skipping these footnote pages (not writing a marker for them) and I need the script to do that.
The solution I've decided is to count the words on each page as I iterate. If there are any pages with 0 text (not including the footnotes) then I will add an additional marker for each blank page.
I have no idea how to do this - I'm so bad with VBA. Does anyone have a solution for me? This feels like an easy thing to do, but I'm pulling my hair out!
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
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 created code to set the pagebreaks in an excel report to deal with the orphan issue (i.e. one line of text spills over onto the next page, etc.). The code works fine when I run it with the report open / visible.
It is part of a larger application which is opened and the code executed from MS Access. Excel is not visible during the process to improve performance.
When I run my code from MS Access it no longer works... it doesn't produce an error, but simply ignores the actual pagebreak setting command.
I read on various forums that in order to avoid this problem, excel needs to be first switched over to ActiveWindow.View = xlPageBreakPreview, but that doesn't work either (I suspect since Excel isn't visible).
I have tested for the following:
Code works when it is started manually or stepped through with F8
Code is executed when called upon from Access (I set breakpoints)
Switching the window view doesn't do anything either
How can I get Excel to change the pagebreaks via code when Excel is run in the background?
This is my code:
Sub TheOrphanProblem()
Dim iPageBrkRow
'Determine if there are page breaks and if so on which row of the document
If FindNthAutoPageBreak(wsRptHolding, 1) Is Nothing Then
'No pagebreak found so we exit the sub
Exit Sub
Else
iPageBrkRow = FindNthAutoPageBreak(wsRptHolding, 1).Row 'Get row
End If
Debug.Print iPageBrkRow
Dim x As Integer
Dim sCase As String
Dim rNewposition As Range
With wsRptHolding
'Code edited out for brevity. This part checks if there is an orphan problem and finds the new position for a pagebreak if needed.
It then provides that position as a range called "rNewposition".
'Moves page break to calculated position
ActiveWindow.View = xlPageBreakPreview
.HPageBreaks.Add rNewposition
ActiveWindow.View = xlNormalView
End With
End Sub
This is the code I use to find the pagebreak positions...
Private Function FindNthAutoPageBreak(Sht As Worksheet, Nth As Long) As Range
'Set page break of the last page so that sub asset groups are kept together
Dim HP As HPageBreak
Dim Ctr As Long
For Each HP In Sht.HPageBreaks
If HP.Type = xlPageBreakAutomatic Then
Ctr = Ctr + 1
If Ctr = Nth Then
Set FindNthAutoPageBreak = HP.Location
End If
End If
Next HP
End Function
Try this
ActiveSheet.DisplayPageBreaks = True