copies pages in document

tariqaleed2 · #1 07-11-2014, 05:34 AM

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

tariqaleed2 · #2 07-19-2014, 01:30 AM

Up
Can not it?

macropod · #3 07-19-2014, 03:00 AM

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

tariqaleed2 · #4 07-19-2014, 10:21 PM

Excellent 100% thank you very much (( macropod )) but can replace the Tariq word if it inside a text box or wordart
Thank you for your response and I really appreciate you this wonderful Help

macropod · #5 07-19-2014, 10:34 PM

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

tariqaleed2 · #6 07-20-2014, 04:01 AM

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

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