Microsoft Word print current page during find and replace

[sberg]

I have code that allows me to find and replace a word in a batch of MS word files. Now I would like to have the program print the page that had a word replaced. Can I get some help with where to insert the code below into the find and replace code below that?

This is my code to print the current page:

Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
Collate:=True, Background:=False, PrintToFile:=False



The code for the find and replace is below:

Function Find_Replace(ByRef Doc As Word.Document, ByRef bMatchWC As Boolean, ByRef FindArray As Variant, _
ByRef ReplaceArray As Variant, ByRef bFWWO As Boolean) As String
Dim rngstory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
Dim x As Long
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For x = 0 To UBound(FindArray)
'Iterate through all story types in the current document
For Each rngstory In Doc.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory rngstory, FindArray(x), ReplaceArray(x), bMatchWC, bFWWO
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
SrcAndRplInStory oShp.TextFrame.TextRange, _
FindArray(x), ReplaceArray(x), bMatchWC, bFWWO
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
Next x
Find_Replace = Doc.Name & " processed successfully."
Err_ReEntry:
Exit Function
Err_Handler:
Find_Replace = Doc.Name & " failed to process. Error summary: " & Err.Description & "."
Resume Err_ReEntry
End Function

Thanks in Advance

 

[SkipVought]

hi,

Using the CurrentPage constant assumes that you are actually paging thru the document, which I assume that you are not.

However, you do have a RANGE object that you are using in your Find/Replace, and I would use THAT object with the wdPrintFromTo constant (see the PrintOut help) AND rather than having th APPLICATION as the reference for the PrintOut method, I'd use the DOCUMENT in which the RANGE has been found for your Find/Replace.

Other than that general advice, I am not a Word VBA guy.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[sberg]

I feel ignorant as I am in the same boat as you when it comes to visual basic. I do a lot more in Excel.

I hope someone can help with the location or correct way to print a current page.

Shawn

 

[sberg]

I re-read the post. I didn't mean to imply that you were ignorant if it came across that way. :-( Sorry about that. I meant to say I am in the same boat as you because I do a lot more visual basic in Excel not in word.

Thanks,
Shawn

 

[SkipVought]

Well you were correct. As far as Word VBA is concerned, I am ignorant of a whole lot of Word-specific objects and methods.

Did you try doing anything with the wdPrintFromTo constant?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[sberg]

I have been tinkering. But I am still at a loss. I can get it to print what I want but not sure where to insert it to get it to be basically at the end of an if statement that if it finds and occurrence then print current page.

 

[SkipVought]

post your code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[sberg]

Option Explicit
Function User_Defined(ByRef Doc As Word.Document) As String
On Error GoTo Err_Handler
'*******
'Put your document processing code here. E.g.:"
MsgBox Doc.Name & " auto process complete."
'*******
User_Defined = Doc.Name & " processed successfully."
Err_ReEntry:
Exit Function
Err_Handler:
User_Defined = Doc.Name & " failed to process. Error summary: " & Err.Description & "."
Resume Err_ReEntry
End Function
Function Convert_Date_Fields(ByRef Doc As Word.Document, ByRef Format As String) As String
Dim rngstory As Word.Range
Dim oFld As Word.Field
Dim oShp As Word.Shape
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
On Error GoTo Err_Handler
With Doc
For Each rngstory In .StoryRanges
'Iterate through all linked stories
Do
For Each oFld In rngstory.Fields
With oFld
If .Type = wdFieldDate Or wdFieldTime Then
.Code.Text = "CREATEDATE \@ " & Format
End If
.Update
End With
Next oFld
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
For Each oFld In oShp.TextFrame.TextRange.Fields
With oFld
If .Type = wdFieldDate Or wdFieldTime Then
.Code.Text = "CREATEDATE \@ " & Format
End If
.Update
End With
Next oFld
End If
Next oShp
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next rngstory
End With
Convert_Date_Fields = Doc.Name & " processed successfully."
Err_ReEntry:
Exit Function
Err_Handler:
Convert_Date_Fields = Doc.Name & " failed to process. Error summary: " & Err.Description & "."
Resume Err_ReEntry
End Function
Function Find_Replace(ByRef Doc As Word.Document, ByRef bMatchWC As Boolean, ByRef FindArray As Variant, _
ByRef ReplaceArray As Variant, ByRef bFWWO As Boolean) As String
Dim rngstory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
Dim x As Long
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For x = 0 To UBound(FindArray)
'Iterate through all story types in the current document
For Each rngstory In Doc.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory rngstory, FindArray(x), ReplaceArray(x), bMatchWC, bFWWO
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
SrcAndRplInStory oShp.TextFrame.TextRange, _
FindArray(x), ReplaceArray(x), bMatchWC, bFWWO
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
Next x
Find_Replace = Doc.Name & " processed successfully."
Err_ReEntry:
Exit Function
Err_Handler:
Find_Replace = Doc.Name & " failed to process. Error summary: " & Err.Description & "."
Resume Err_ReEntry
End Function
Public Sub SrcAndRplInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, ByVal strReplace As String, _
ByVal bMatchWildCards As Boolean, ByVal bFindWWO As Boolean)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.MatchWildcards = bMatchWildCards
.MatchWholeWord = bFindWWO
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
Function Convert_Docs(ByRef Doc As Word.Document, ByRef bMaintainCompatibility As Boolean) As String
Dim pDocName As String
Dim i As Long
On Error GoTo Err_Handler
pDocName = ActiveDocument.FullName
i = InStrRev(pDocName, ".")
pDocName = Left(pDocName, i - 1)

ActiveDocument.SaveAs FileName:=pDocName, FileFormat:= _
wdFormatXMLDocument, AddToRecentFiles:=False
If Not bMaintainCompatibility Then
ActiveDocument.Convert
End If
Convert_Docs = Doc.Name & " processed successfully."
Err_ReEntry:
Exit Function
Err_Handler:
Convert_Docs = Doc.Name & " failed to process. Error summary: " & Err.Description & "."
Resume Err_ReEntry
End Function
Sub Test()
Dim pArray
pArray = Split("Test|DOG", "|")
MsgBox Find_Replace(ActiveDocument, True, pArray, pArray)
End Sub

 

[SkipVought]

I see NOTHING about PRINT!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[fumei]

Not totally following. I think you are asking about this Sub.

Public Sub SrcAndRplInStory(ByVal rngstory As Word.Range, _
    ByVal strSearch As String, _
    ByVal strReplace As String, _
    ByVal bMatchWildCards As Boolean, _
    ByVal bFindWWO As Boolean)

   With rngstory.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = strSearch
      .Replacement.Text = strReplace
      .MatchWildcards = bMatchWildCards
      .MatchWholeWord = bFindWWO
      .Execute Replace:=wdReplaceAll
   End With
End Sub

This is your replace procedure. However, you are NOT actioning separate Found instances of your search string. You have:

.Execute Replace:=wdReplaceAll

Thus ALL are replaced. If you are qasking about printing the page for each Found instance of the search string, you have to change the iteration.

And this is not as easy as you may think. The problem is the word "page". Page is a very tricky thing in Word, as it is not a real object. This is a case - rare - where it is MUCH easier to use Selection, rather than Range.

If you Select the Found instance of the search string, then you have the current page pre-defined bookmarks available to you. You do NOT have these if you are only using Range.

Here is your code, changing to Selection. Can it be done still keeping Range? Yes. But again, in this case, using selection is a lot simpler.

Sub Blah()
Dim r As Range
Dim strSearch As String
strSearch = "Yadda"

Set r = ActiveDocument.Range
With r.Find
   Do While .Execute(Findtext:=strSearch, Forward:=True) = True
      r.Select
   Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
      wdPrintDocumentContent, Copies:=1, Pages:=""
      r.Collapse 0
   Loop
End With
End Sub

It does the search, and if it finds it, selects it, and then uses PrintCurrentPage, collapses, and continues.

If the search string is found three times on a page, that page will be printed three times.


unknown

 

[macropod]

If the search string is found three times on a page, that page will be printed three times.

And managing this, so as to print only one instance per page, can be tricky when the Find & Replace strings alter the pagination.


Cheers
[MS MVP - Word]

 

[fumei]

You bet. Tricky? That is putting it mildly. Never mind if the Replace changes pagination. Even if it did not, it still would be tricky (though possible) to have a Found on a page, and then check to see if there are any other Found on the same page. However, as the OP did not stipulate either for, or against, multiple printing for multiple Founds/per page - shrug - I played it straight. Each Found = one printing.


unknown

 

[macropod]

Hi Gerry,

And when a single F/R spans more than one page?


Cheers
[MS MVP - Word]

 

[fumei]

Ummmmm...gulp....


unknown