[RESOLVED] Need help with replace a function-VBForums
Results 1 to 1 of 1

Thread: [RESOLVED] Need help with replace a function

  1. #1

    Thread Starter
    Lively Member elmnas's Avatar
    Join Date
    Jul 2009
    Posts
    127

    Resolved [RESOLVED] Need help with replace a function

    Hello guys I have wrote a very long script,
    my script
    it creates a folder also copy .pdf files
    from source to a target.
    copy specific content from one document
    open another template.dot paste the content
    set right format etc.

    Could someone help me,

    I have used Word.range find the word "claims"

    until the next "^11"
    but I dont want to use wordrange
    I want to replace with this function

    Could someone help me to correct the code?


    see code for new function
    PHP Code:
    Selection.Find.ClearFormatting
        Selection
    .Find.Replacement.ClearFormatting
        With Selection
    .Find
            
    .Text "^11^11Claims^013*^013^11^11"
            
    .Replacement.Text ""
            
    .Forward True
            
    .Wrap wdFindAsk
            
    .Format False
            
    .MatchCase False
            
    .MatchWholeWord False
            
    .MatchAllWordForms False
            
    .MatchSoundsLike False
            
    .MatchWildcards True
        End With
        With Selection
    .Find
        Selection
    .Find.Execute
        Selection
    .Copy
        End With 

    here is my code could someone help me?
    insert the function and replace the range.word function?

    PHP Code:
    Sub rws_EN()

    Dim StrOldPath As StringStrNewPath As StringstrFile
    StrOldPath 
    ActiveDocument.Path
    StrNewPath 
    Left(StrOldPathInStrRev(StrOldPath"\"))
    StrOldPath = StrOldPath & "
    \"
    StrNewPath = StrNewPath & "
    translation to\"

    If Dir(StrNewPath, vbDirectory) = "" Then
      MkDir StrNewPath
    End If
    strFile = Dir(StrOldPath & "
    *.PDF", vbNormal) '// selecting format "*.pdf"
    While strFile <> ""
      FileCopy StrOldPath & strFile, StrNewPath & strFile
      strFile = Dir()
    Wend



    '------------------------------------------------------------------------------
    ' finds the word "
    claims"
    ' also find correct format

    Dim oRng As Word.Range
    Set oRng = ActiveDocument.Range
        With oRng.Find
        .Text = "
    Claims" ' the loop starts here find word claims
        .Font.Name = "
    Arial"
        .Font.Bold = True
        Do While .Execute
        oRng.MoveEndUntil Chr(11)
        oRng.MoveEnd wdCharacter, 1
        oRng.MoveEndUntil Chr(11)
        oRng.HighlightColorIndex = wdBrightGreen
        oRng.Collapse wdCollapseEnd
        Loop
        End With

            With Selection.Find
                .Text = "
    ^11" ' the loop ends here last word it searching for.
                End With
                
                With Selection.Find ' remove all empty lines
                .Replacement.Text = ""
                .Execute Replace:=wdReplaceAll, Forward:=True, _
                Wrap:=wdFindContinue
            End With


    ' sets activedocument on the document I have opened
    ' open the template "
    NewEuropat.dot"
    '
    Dim thisdoc As Document
    Dim Str
    Set thisdoc = ActiveDocument
    Dim targDoc As Word.Document
    Set targDoc = Application.Documents.Open("
    G:\patent\NewEuropat.dot")
    Documents(thisdoc).Activate

    For Each Str In ActiveDocument.StoryRanges
        Str.Find.ClearFormatting
        Str.Find.Text = ""
        Str.Find.Highlight = True

    While Str.Find.Execute
        Str.Copy
        Documents(targDoc).Activate
        Selection.MoveRight Unit:=wdCharacter, Count:=50
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.Paste
        Documents(thisdoc).Activate
    Wend
    Next

    '------------------------------------------------------------------------------
    ' put correct format on the template with all settings
        With cleanform
            Documents(targDoc).Activate ' activating NewEuropat.dot
            Selection.WholeStory '
            Options.DefaultHighlightColorIndex = wdNoHighlight
            Selection.Range.HighlightColorIndex = wdNoHighlight ' remove all highlighted text
            Selection.Font.Bold = wdToggle
            Selection.Font.Bold = wdToggle
            Selection.Font.Name = "
    Times New Roman" ' set font
            Selection.Font.Size = 12 ' set size
        End With
              With Selection.ParagraphFormat
                .LeftIndent = CentimetersToPoints(0)
                .RightIndent = CentimetersToPoints(0)
                .SpaceBefore = 0
                .SpaceBeforeAuto = False
                .SpaceAfter = 0
                .SpaceAfterAuto = False
                .LineSpacingRule = wdLineSpace1pt5 ' set linespacing
                .Alignment = wdAlignParagraphJustify
                .WidowControl = True
                .KeepWithNext = False
                .KeepTogether = False
                .PageBreakBefore = False
                .NoLineNumber = False
                .Hyphenation = True
                .FirstLineIndent = CentimetersToPoints(0)
                .OutlineLevel = wdOutlineLevelBodyText
                .CharacterUnitLeftIndent = 0
                .CharacterUnitRightIndent = 0
                .CharacterUnitFirstLineIndent = 0
                .LineUnitBefore = 0
                .LineUnitAfter = 0
                .MirrorIndents = False
                .TextboxTightWrap = wdTightNone
             End With
            
    End Sub 
    Last edited by elmnas; Jul 24th, 2014 at 06:36 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.