View Single Post
 
Old 03-28-2016, 05:03 AM
rpb925 rpb925 is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Mar 2016
Location: Sydney
Posts: 17
rpb925 is on a distinguished road
Default Calling Sub Routine for Formatting recently Created Word Document

Hi All,
So I have a database which I push a button on and it opens word and puts heaps of data into. However access text fields don't allow formatting so I've set up my own formatting in a way by putting in key words such as , <bold>I want this text bold<bold/>. At I wish to run a sub routine to do this formatting and then delete the traces ie the text <bold> and <bold/>. I have something already but I believe I am using the .selection method which I shouldn't be and I'm not sure what variables I have to define in the sub routine.

Here is the background of the Main routine

Code:
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim Tbl As Word.Table

'Open Word
  Set wdApp = CreateObject("Word.Application")
  With wdApp
    .Visible = True
    .ScreenUpdating = False
'Create a new document
    Set wdDoc = .Documents.Add
    With wdDoc
‘Here I do lots and lots of stuff and a whole heap of texts gets inserted from a database made possible with help from Paul
‘HERE IS WHERE I WANT TO CALL FORMATTING SUB ROUTINE
?Call IRDEFormat()?
.SaveAs CurrentProject.Path & "\TestDoc.doc"
'end with doc
End With
    .ScreenUpdating = True

'end with objword
  End With
Set wdRng = Nothing: Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
End Sub
Ok Now for IRDEFormat which is where I have my problems. I think there are some fundamental mistakes guidance would be heaven sent. Background is I want it to look for
<italics> and <italics/> format in between and then delete them
<bold> and <bold/> format in between and then delete them
<indent> and <indent/> format indentation in between then delete them

Not so good code is below. It seems like alot but it's repetitive.

Code:
Sub IRDEFormat()

Dim wdApp As Word.Application

'INDENT

'Format Word Document
With wdApp

'Move selectiion to start of document
.Selection.HomeKey wdStory

'To ensure that formatting isn't included as criteria in a find or replace operation, use this method before carrying out the operation
.Selection.Find.ClearFormatting

End With

'Find <indent> set range at <indent/>
With wdApp.Selection.Find

'expression .Execute(FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace, MatchKashida, MatchDiacritics, MatchAlefHamza, MatchControl)
Do While .Execute(FindText:="<indent>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = wdApp.Selection.Range 'Setting property of range
myrange.End = wdApp.ActiveDocument.Range.End 'Set Range to rest of Document
'Instr Returns an integer specifying the start position of the first occurrence of one string within another.
myrange.End = myrange.Start + InStr(myrange, "<indent/>")
myrange.Select

'with range make formatting changes

    With wdApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LeftIndent = wdApp.CentimetersToPoints(1)
.FirstLineIndent = wdApp.CentimetersToPoints(-1)
    End With
wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1

'Loop to next

Loop
End With

'BOLD

'Restart at beggining

With wdApp
.Selection.HomeKey wdStory
.Selection.Find.ClearFormatting

End With

'Define Range

With wdApp.Selection.Find
Do While .Execute(FindText:="<bold>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = wdApp.Selection.Range
myrange.End = wdApp.ActiveDocument.Range.End
myrange.End = myrange.Start + InStr(myrange, "<bold/>")
myrange.Select

'format

    With wdApp.Selection.Font
.Bold = True
    End With

wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1

'Loop to next
Loop
End With

'ITALICS

With wdApp
.Selection.HomeKey wdStory
.Selection.Find.ClearFormatting

End With

'Define Range

With wdApp.Selection.Find
Do While .Execute(FindText:="<italics>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = wdApp.Selection.Range
myrange.End = wdApp.ActiveDocument.Range.End
myrange.End = myrange.Start + InStr(myrange, "<italics/>")
myrange.Select

'format

    With wdApp.Selection.Font
.Italic = True
    End With


wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1

'Loop to next
Loop
End With

'Delete formating symbols

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<indent>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=False, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<indent/>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<bold>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<bold/>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<italics>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<italics/>"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
wdApp.Selection.WholeStory
 With wdApp.Selection.Find
    .ClearFormatting
    .Text = "<tab>"
    .Replacement.ClearFormatting
    .Replacement.Text = vbTab
    .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
End With

wdApp.Selection.HomeKey wdStory
 End Sub
Cheers Ron
Reply With Quote