Quote:
Originally Posted by gekser
The problem is not with the printer but rather with page margins, line distance, font size, etc.
|
Changing the printer (or even just the driver) is enough on its own to affect Word's pagination. This is a well-documented fact.
A macro that processes each page separately requires significantly more code to iterate through the pages and limit the Find ranges to the 'current' page only. But doing that with a simple 'ReplaceAll' wouldn't achieve anything that doing the same for the whole document in one pass would do. From your last post, however, I gather you only want the words highlighted when they occur more than once on the same page. Managing that adds yet another layer of complication. Try the following:
Code:
Sub FindDuplicatesByPage()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, arrWords
Dim RngPg As Range, Rng As Range, Rng1 As Range
arrWords = Array("Lorem", "ipsum", "dolor", "amet")
With ActiveDocument
For i = 1 To .ComputeStatistics(wdStatisticPages)
For j = 0 To UBound(arrWords)
Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
Set RngPg = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
k = 0
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = arrWords(j)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = False
.Execute
End With
If .Find.Found Then Set Rng1 = .Duplicate
Do While .Find.Found
If .InRange(RngPg) Then
k = k + 1
If k > 1 Then .Duplicate.HighlightColorIndex = wdBrightGreen
Else
Exit Do
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
If k > 1 Then Rng1.HighlightColorIndex = wdBrightGreen
Set Rng1 = Nothing
End With
Next
Next
End With
Application.ScreenUpdating = True
End Sub