#1
|
|||
|
|||
copies pages in document
Dear brothers
I want code vba ms word to (duplication) copy the first page with same format 10 copies to get 11 pages in the document, and then only in the page number 5 replaces the word text Tariq to jonson thank you very mauch |
#2
|
|||
|
|||
Up
Can not it? |
#3
|
||||
|
||||
Try:
Code:
Sub Demo() Dim Rng As Range, i As Long With ActiveDocument.Range Set Rng = .GoTo(What:=wdGoToPage, Name:=1) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") With Rng .Copy For i = 1 To 10 .InsertAfter vbCr & Chr(12) .Collapse wdCollapseEnd .Paste Next End With Set Rng = .GoTo(What:=wdGoToPage, Name:=5) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") With Rng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "Tariq" .Replacement.Text = "Johnson" .Format = False .Forward = True .Wrap = wdFindStop .MatchCase = True .MatchWholeWord = True .Execute Replace:=wdReplaceAll End With End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
||||
|
||||
For that you could use code like:
Code:
Sub Demo() Dim Rng As Range, i As Long Dim Shp As Shape, iShp As InlineShape Dim StrFnd As String, StrRep As String StrFnd = "Tariq": StrRep = "Johnson" With ActiveDocument.Range Set Rng = .GoTo(What:=wdGoToPage, Name:=1) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") With Rng .Copy For i = 1 To 10 .InsertAfter vbCr & Chr(12) .Collapse wdCollapseEnd .Paste Next End With Set Rng = .GoTo(What:=wdGoToPage, Name:=5) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") Call Update(Rng, StrFnd, StrRep) For Each Shp In Rng.ShapeRange If Shp.TextFrame.HasText = True Then Call Update(Shp.TextFrame.TextRange, StrFnd, StrRep) Next Next For Each iShp In Rng.InlineShapes If iShp.TextFrame.HasText = True Then Call Update(iShp.TextFrame.TextRange, StrFnd, StrRep) Next Next End With End Sub Sub Update(Rng As Range, StrFnd As String, StrRep As String) With Rng.Find .ClearFormatting .Replacement.ClearFormatting .Text = StrFnd .Replacement.Text = StrRep .Format = False .Forward = True .Wrap = wdFindStop .MatchCase = True .MatchWholeWord = True .Execute Replace:=wdReplaceAll End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
Thank you very much for the quick response
THE Code did not work I Modified the code is working now, and I hope YOU Modified if it needs it Thanks (( macropod )) Regards Code:
Sub Demo3() Dim rng As Range, i As Long Dim Shp As shape Dim iShp As InlineShape Dim StrFnd As String, StrRep As String StrFnd = "TARIQ": StrRep = "Johnson" With ActiveDocument.Range Set rng = .GoTo(What:=wdGoToPage, Name:=1) Set rng = rng.GoTo(What:=wdGoToBookmark, Name:="\page") With rng .Copy For i = 1 To 10 .InsertAfter vbCr & Chr(12) .Collapse wdCollapseEnd .Paste Next End With Set rng = .GoTo(What:=wdGoToPage, Name:=5) Set rng = rng.GoTo(What:=wdGoToBookmark, Name:="\page") Call Update(rng, StrFnd, StrRep) For Each Shp In rng.ShapeRange If Shp.TextFrame.HasText = True Then Call Update(Shp.TextFrame.TextRange, StrFnd, StrRep) End If Next With rng.Find For Each iShp In rng.InlineShapes If iShp.TextEffect.Text = "TARIQ" Then iShp.TextEffect.Text = "Johnson" End If Next End With End With End Sub Sub Update(rng As Range, StrFnd As String, StrRep As String) With rng.Find .ClearFormatting .Replacement.ClearFormatting .Text = StrFnd .Replacement.Text = StrRep .Format = False .Forward = True .Wrap = wdFindStop .MatchCase = True .MatchWholeWord = True .Execute Replace:=wdReplaceAll End With End Sub Last edited by macropod; 08-23-2014 at 02:56 AM. Reason: Added code tags & formatting |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Print copies of onepage document with different text | kciejek | Word VBA | 4 | 06-03-2014 03:21 AM |
Sequentially numbered copies of multi-page word document | Mark Paterson | Word VBA | 3 | 05-16-2014 04:34 PM |
Generating Fresh Copies Of an Excel Document | callumwk | Excel | 2 | 04-09-2012 06:13 AM |
Mutliple copies 167 print as one document | John-N | Mail Merge | 5 | 02-19-2012 07:15 PM |
Merging Multiple Copies of the Same Document | bshatto | Word | 0 | 10-19-2009 06:22 AM |