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 String, StrNewPath As String, strFile
StrOldPath = ActiveDocument.Path
StrNewPath = Left(StrOldPath, InStrRev(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