How can I test whether the insertion point is at the start of a new page created by a manual page break? It seems like it should be as simple as checking if the preceding character is CHR(12), but that doesn't seem to work.
If Selection.Type = CHR(12) Then
Selection.TypeText Text:="HARD PAGE"
Else
Selection.TypeText Text:="NO HARD PAGE"
End If
Is it just a syntax error or do I have the wrong approach here?
You have to move the selection (or the range) backwards. Selection.Text (or Range.Text) always returns the character following the IP. Of course, you may not want to actually move the selection. That means you can work with a Range object to do the testing.
Since you have to move backwards, anyway, to test whether there's a hard pagebreak, I've put it in a loop so that the selection can be anywhere on the page, to begin with.
Also, I've added a check whether the macro has started on the first page, since you'd otherwise go into an infinite loop, moving backwards from the Selection to the next page.
Sub CheckWhetherHardPageBreak()
Dim rngToCheck As word.Range
Dim pgNr As Long
Dim pgNrChange As Long
Set rngToCheck = Selection.Range
pgNr = rngToCheck.Information(wdActiveEndPageNumber)
If pgNr = 1 Then
MsgBox "Can't start on Page 1"
Exit Sub
End If
pgNrChange = pgNr
Do While pgNrChange = pgNr
rngToCheck.MoveEnd wdCharacter, -1
pgNrChange = rngToCheck.Information(wdActiveEndPageNumber)
Loop
'Extend the selection to include the following character
'So that ASC() works
rngToCheck.MoveEnd wdCharacter, 1
If Asc(rngToCheck.Text) <> 12 Then
'Move it back before the previous character
'as the character immediately following a hard page break is Chr(13)
rngToCheck.MoveEnd wdCharacter, -2
End If
rngToCheck.MoveEnd wdCharacter, 1
If Asc(rngToCheck) = 12 Then
Selection.TypeText Text:="HARD PAGE"
Else
Selection.TypeText Text:="NO HARD PAGE"
End If
End Sub
I think you might be intending to use Chr(13) or Chr(10).
More information here:
Stack Overflow: What are carriage return, linefeed, and form feed?
Related
Would appreciate some help with this problem.
I need to find all occurrences of a string in a Word document. When the string is found some complicated editing is performed on it. Sometimes no editing is needed and the string is left untouched. When all that is taken care of, I continue looking for the next occurrence of the string. Until the end of the document.
I wrote a routine to do that :
It starts by defining a Range (myRange) that covers the whole document.
Then a Find.Execute is performed.
When an occurrence is found I do the editing work.
Meanwhile myRange has been automatically redefined to cover only the found region (this is well documented in the VBA WORD documentation > FIND Object).
Then I redefine myRange to cover the portion of the text from the end of the previous found region down to the end of the text.
I iterate this until the end of the document.
This routine works well EXCEPT when an occurrence of the string is found in a TABLE. Then it is impossible to redefine myRange to cover the region from the end of the previous found down to the end of the text. In the redefinition VBA insists on including the previous found region (actually the whole TABLE). So when I iterate it keeps finding the same occurrence again and again and looping for ever.
What follows is a simplified version of my routine. It does nothing it is just to illustrate the problem. If you run it on a document where the string "abc" appears you will see it running happily to completion. But if your document has an occurrence of "abc" in a TABLE the routine loops for ever.
Sub moreTests()
Dim myRange As Range
Dim lastCharPos As Integer
Set myRange = ActiveDocument.Range
lastCharPos = myRange.End
myRange.Find.ClearFormatting
With myRange.Find
.Text = "abc"
End With
While myRange.Find.Execute = True
'An occurrence of "abc" has been found
MsgBox (myRange.Text)
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
'myRange has been redefined to encompass only the found region (the "abc" string)
'Perform whatever editing work is needed on the string myRange.Text ("abc")
'Now redefine myRange to cover the remainder of the document
myRange.Start = myRange.End
myRange.End = lastCharPos
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
Wend
End Sub 'moreTests
I have several ways in mind to circumvent this problem. But none of them is simple, let alone 'elegant'. Does someone know if there is a 'standard' / 'proven' way of avoiding this problem ?
Many many thanks in advance.
I'm programmatically filling in a regulated form template where lines are predefined (as table cells):
(Using plain text Content Controls as placeholders but this isn't relevant to the current question.)
So, I have to break long text into lines manually (auto-adding rows or something is not an option because page breaks are also predefined).
Now, since characters have different width, I cannot just set some hardcoded character limit to break at (or rather, I can, and that's what I'm doing now, but this has proven to be inefficient and unreliable, as expected). So:
How do I check if a Range of text fits on a single line -- and if it doesn't, how much of it fits?
I've checked out Range Members (Word) but can't see anything relevant.
The only way is to .Select that text, them manipulate the selection. Selection in the only object for which you can use wdLine as a boundary. Nothing else in the Word object model works with automatic line breaks.
Sub GetFirstLineOfRange(RangeToCheck As Range, FirstLineRange As Range)
'Otherwise, Word doesn't always insert automatic line breaks
'and all the text will programmatically look like it's on a single line
If Not Application.Visible Or Not Application.ScreenUpdating Then
Application.ScreenRefresh
End If
Dim SelectionRange As Range
Set SelectionRange = Selection.Range
Set FirstLineRange = RangeToCheck
FirstLineRange.Select
Selection.Collapse Direction:=wdCollapseStart
Selection.EndOf Unit:=wdLine, Extend:=wdExtend
Set FirstLineRange = Selection.Range
If FirstLineRange.End > RangeToCheck.End Then
FirstLineRange.End = RangeToCheck.End
End If
SelectionRange.Select
End Sub
Function IsRangeOnOneLine(RangeToCheck As Range) As Boolean
Dim FirstLineRange As Range
GetFirstLineOfRange RangeToCheck, FirstLineRange
IsRangeOnOneLine = FirstLineRange.End >= RangeToCheck.End
End Function
The subroutine GetFirstLineOfRange takes a RangeToCheck and sets FirstLineRange to the first text line in the given range.
The function IsRangeOnOneLine takes a RangeToCheck and returns True if the range fits on one line of text, and False otherwise. The function works by getting the first text line in the given range and checking whether it contains the range or not.
The manipulation of the Selection in GetFirstLineOfRange is necessary because the subroutine wants to move the end of the range to the end of the line, and the movement unit wdLine is available only with Selection. The subroutine saves and restores the current Selection; if this is not necessary then the temporary variable SelectionRange and the associated statements can be deleted.
Note:
There is no need to scroll anything - which in any event is not reliable. Try something based on:
With Selection
If .Characters.First.Information(wdVerticalPositionRelativeToPage) = _
.Characters.Last.Information(wdVerticalPositionRelativeToPage) Then
MsgBox .Text & vbCr & vbCr & "Spans one line or less."
Else
MsgBox .Text & vbCr & vbCr & "Spans more than one line."
End If
End With
Sometimes I have code blocks in my Word documents, and I want to work with them without copying to plain text editor.
Namely, I want to have an ability to indent/unindent multiple lines of code using "Tab" character. This task is very simple in any plain text editor or IDE, but for the sake of clarity, I will show it here. Tabs are shown as black arrows:
Initial state
Using the Shift key or mouse, I selected a part of JavaScript function
Then I pressed Tab key on my keyboard
Selected lines were indented by inserting tab character on each line.
How it could be done with VBA?
Since I don't post any code (as evidence of my own efforts), I don't expect to get something completely working. But at least, I hope to get an understanding "how" it could be done.
As David suggested, I recorded a macro. Here how it looks:
Sub Indentator()
Selection.TypeText Text:=vbTab
End Sub
The problem is, that I don't understand how to get it work for multiple lines. If I select them, this macro (and it was not surprise for me) just inserts "Tab" instead of selection.
Insert a tab character at the start of each paragraph in the selection:
Sub Indentator()
Dim para As Paragraph
For Each para In Selection.Paragraphs
para.Range.InsertBefore vbTab
Next
End Sub
(This assumes that each of your code "lines" is a new "paragraph" in Word, which it usually would be if you are intending to copy/paste this to/from actual code.)
If the macros are named IncreaseIndent and DecreaseIndent, they can be run using the Increase and Decrease Indent buttons on the Home tab.
Sub IncreaseIndent()
If Selection.Start = Selection.End Then
Selection.InsertBefore vbTab
Selection.Start = Selection.End
Else
Dim p As Paragraph
For Each p In Selection.Paragraphs
p.Range.InsertBefore vbTab
Next
End If
End Sub
Sub DecreaseIndent()
If Selection.Start = Selection.Paragraphs(1).Range.Start Then
Selection.Start = Selection.Start + 1
End If
Dim p As Paragraph, c As Range
For Each p In Selection.Paragraphs
Set c = p.Range.Characters(1)
If c.Text = vbTab Then c.Delete
Next
End Sub
Reference https://wordmvp.com/FAQs/MacrosVBA/InterceptSavePrint.htm
I'm basically trying to create a cumulative word count for documents that will put the number of words on each page into its footer and add it to the total words each page. After a lot of looking around, I found that Word doesn't really handle pages the same for everybody and so doesn't have any interface to access the individual pages through.
Now I'm trying to separate each page with page breaks so there's a clear delimiter between pages, but I still can't find how to loop through these. Any clues?
I'm going to post the code I have, but it's only for getting the word count currently. No proper attempts at cycling through page breaks because I don't know how.
Sub getPageWordCount()
Dim iPgNum As Integer
Dim sPgNum As String
Dim ascChar As Integer
Dim rngPage As Range
Dim iBeginPage As Integer
Dim iEndPage As Integer
' Go to start of document and make sure its paginated correctly.
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
ActiveDocument.Repaginate
' Loop through the number of pages in the document.
For iPgNum = 2 To Selection.Information(wdNumberOfPagesInDocument)
sPgNum = CStr(iPgNum)
iBeginPage = Selection.Start
' Go to next page
Selection.GoTo wdGoToPage, wdGoToAbsolute, sPgNum
' and to the last character of the previous page...
Selection.MoveLeft wdCharacter, 1, wdMove
iEndPage = Selection.Start
' Retrieve the character code at insertion point.
Set rngPage = ActiveDocument.Range(iBeginPage, iEndPage)
MsgBox rngPage.ComputeStatistics(wdStatisticWords)
'rngPage.Footers(wdHeaderFooterPrimary).Range.Text = rngPage.ComputeStatistics(wdStatisticWords)
'ActiveDocument.Sections(2).Footers
' Check the character code for hard page break or text.
Next
' ActiveDocument.Sections(2).Footers(wdHeaderFooterPrimary).Range.Text = "bob" 'Testing
End Sub
Finally got it, managed to guess my way through it a bit, taking assorted bits from dark corners of the internet:
Sub getPageWordCount()
'Replace all page breaks with section breaks
Dim myrange1 As Range, myrangedup As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="^m", Forward:=True, _
MatchWildcards:=False, Wrap:=wdFindStop) = True
Set myrange = Selection.Range
Set myrangedup = Selection.Range.Duplicate
myrange.Collapse wdCollapseEnd
myrange.InsertBreak wdSectionBreakNextPage
myrangedup.Delete
Loop
End With
'Unlink all footers and insert word count for each section
Dim sectionCount, sectionNumber, i, sectionWordCount, cumulativeWordCount As Integer
sectionCount = ActiveDocument.Sections.Count
For sectionNumber = 1 To sectionCount
With ActiveDocument.Sections(sectionNumber)
sectionWordCount = .Range.ComputeStatistics(wdStatisticWords)
cumulativeWordCount = cumulativeWordCount + sectionWordCount
With .Footers.Item(1)
.LinkToPrevious = False
.Range.Text = "This page's word count: " + CStr(sectionWordCount) + " | Cumulative word count: " + CStr(cumulativeWordCount)
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
End With
Next
End Sub
And now I've just discovered that if I want to port this macro to an add-in for ease of use for non-techy users I have to write it in VB 2010 in Visual Studio where the API is different. Good luck me!
It sounds as if you have what you need, but I was working on an alternative that I may as well post because it does not require you to add page breaks or section breaks. But you would have to add the same nested field in each footer that appears in the document (I haven't done that part here, but it's not completely trivial because there may be multiple sections and multiple footers per section).
The field code you need to add (in addition to your 'This page's word count: ' text) is
{ DOCVARIABLE "s{ SECTION }p{ PAGE \*arabic }" }
As written, the method may break in some circumstances, e.g. if there are continuous section breaks. I haven't checked.
Sub createWordCounts()
Dim i As Integer
Dim rng As Word.Range
With ActiveDocument
For i = 1 To .Range.Information(wdActiveEndPageNumber)
Set rng = .GoTo(wdGoToPage, wdGoToAbsolute, i).Bookmarks("\page").Range
.Variables("s" & CStr(rng.Information(wdActiveEndSectionNumber)) & "p" & CStr(rng.Information(wdActiveEndAdjustedPageNumber))).Value = rng.ComputeStatistics(wdStatisticWords)
Set rng = Nothing
Next
End With
End Sub
I have a problem with adjusting selection inside of a table. I have a function that goes through a document word by word to analyze it's contents looking for specific patterns. Unfortunately, in tables Char(7) character breaks the selection - when it's selected, all cells become selected automatically. To work around this problem I store the proper Selection.Start parameter.
Here is my code:
If InStr(Selection.text, Char(7)) > 0 Then
Selection.start = selStart
Selection.End = selStart + (Len(tekst) - 2)
End If
Well, it did not help. I can see, while debugging, that selStart is 441 and Selection.Range.Start is 427 (427 would be the beginning of the cell, when the word I'm looking for is on the position of 441). In the next step... Selection.Start still is 427.
I've also tried another aproach using MoveStart and MoveEnd but no matter what I do, the Selection.Start doesn't change.
Well of course!
I can't move Selection.Start, while Chr(7) is in the selection! Everything works perfectly when I move Selection.End fisrt...
If InStr(Selection.text, Chr(7)) > 0 Then
Selection.MoveEnd Unit:=wdCharacter, Count:=-1
Selection.start = selStart
End If
Maybe a different approach is in order: rather than manipulate the selection, iterate the Document.Words collection. Something like:
Sub PreccessAllWords()
Dim doc As Document
Dim wd As Range
Set doc = ActiveDocument
For Each wd In doc.Words
If wd.Text = "Foo " Then
wd.Text = "Bar "
End If
Next wd
End Sub