Calling Sub Routine for Formatting recently Created Word Document

rpb925 · #1 03-28-2016, 05:03 AM

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

gmaxey · #2 03-28-2016, 06:02 AM

I don't want my eyes to start bleeding so I am not going to try to read your code.

"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"

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim arrTerms() As String
Dim oRng As Range
Dim lngIndex As Long
  arrTerms = Split("(\<italics\>)(*)(\<italics/\>)|(\<bold\>)(*)(\<bold/\>)|(\<indent\>)(*)(\<indent/\>)", "|")
  For lngIndex = 0 To UBound(arrTerms)
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = arrTerms(lngIndex)
      .MatchWildcards = True
      Select Case lngIndex
        Case 0: .Replacement.Font.Italic = True
        Case 1: .Replacement.Font.Bold = True
        Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
      End Select
      .Replacement.Text = "\2"
      .Execute Replace:=wdReplaceAll
   End With
  Next
lbl_Exit:
  Exit Sub
End Sub

rpb925 · #3 03-28-2016, 08:02 PM

Greg,

That is mind boggling. It's so concise. Thanks heaps The eyes bleeding was a good burn by the way. So the code works perfectly when I run as a normal macro in a word document but when I try and call it from my vba in access for a nearly created word document its not working so I don't believe I am calling it correctly or it isn't being referenced. I have saved the script in a module. Then I call the sub routine. The script runs but nothing happens. So I think it is the following line that might not be referencing the document correctly as I am not in the document as such it has just been created and is being filled with text using VBA. Is there any other way to reference the newly created word document.
Your reference

Code:

Set oRng = ActiveDocument.Range

In the father routine it is referenced as follows

Code:

'Create a new document
    Set wdDoc = .Documents.Add
    With wdDoc

Can I use the reference wdDoc or can I not use the reference from the father routine in the child sub routine?

Thanks.

macropod · #4 03-28-2016, 09:00 PM

Quote:

Originally Posted by rpb925

That is mind boggling. It's so concise.

Nah, it's verbose!

Consider:

Code:

Sub Demo()
Dim arrTerms(), i As Long
arrTerms = Array("italics", "bold", "indent")
With ActiveDocument.Range.Find
    .MatchWildcards = True
    .Replacement.Text = "\3"
    For i = 0 To UBound(arrTerms)
        .Replacement.ClearFormatting
        .Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"
        Select Case i
            Case 0: .Replacement.Font.Italic = True
            Case 1: .Replacement.Font.Bold = True
            Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
        End Select
        .Execute Replace:=wdReplaceAll
    Next
End With
End Sub

gmayor · #5 03-28-2016, 09:06 PM

Either way, you should make some small changes to the macro to run it from another application e.g. as follows - call it with MyReplacements wdDoc

Code:

Sub MyReplacements(oDoc As Object)
'A basic Word macro coded by Greg Maxey
'as modified by Graham Mayor ;)
Dim arrTerms() As String
Dim oRng As Object
Dim lngIndex As Long
    arrTerms = Split("(\<italics\>)(*)(\<italics/\>)|(\<bold\>)(*)(\<bold/\>)|(\<indent\>)(*)(\<indent/\>)", "|")
    For lngIndex = 0 To UBound(arrTerms)
        Set oRng = oDoc.Range
        With oRng.Find
            .Text = arrTerms(lngIndex)
            .MatchWildcards = True
            Select Case lngIndex
                Case 0: .Replacement.Font.Italic = True
                Case 1: .Replacement.Font.Bold = True
                Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
            End Select
            .Replacement.Text = "\2"
            .Execute Replace:=2
        End With
    Next
lbl_Exit:
    Set oRng = Nothing
    Set oDoc = Nothing
    Exit Sub
End Sub

gmaxey · #6 03-29-2016, 02:36 AM

Refined well Paul and Graham.

As a alternate to defining the parameter oDoc and passing wdDoc, you may be able to declare wdDoc at the module level and simply replace ActiveDocument (in my case) or oDoc (in Graham') with wdDoc.

rpb925 · #7 03-30-2016, 06:53 AM

Thanks alot guys especially Greg. I got it working in the main script but still can't get it going in a module it doesn't
know what I'm refering to when I use wdDoc but it does in the main script so that'll do. If it ain't broke.....
This is what I ended up using anyway.

Code:

arrTerms = Split("(\<italics\>)(*)(\<italics/\>)|(\<bold\>)(*)(\<bold/\>)|(\<indent\>)(*)(\<indent/\>)", "|")
  For lngIndex = 0 To UBound(arrTerms)
    Set wdRng = wdDoc.Range
    With wdRng.Find
      .Text = arrTerms(lngIndex)
      .MatchWildcards = True
      Select Case lngIndex
        Case 0: .Replacement.Font.Italic = True
        Case 1: .Replacement.Font.Bold = True
        Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
      End Select
      .Replacement.Text = "\2"
      .Execute Replace:=wdReplaceAll
   End With
  Next

This seems like super great code that I will use again but i can't really work out how it works could you please break it down for me. And say add another section that replaces <tab> with a vbtab. So I can compare and see how it works. Any explanations would be great. Below I have sort of explained how I see it. Actually probably
better stated how I don't see it.

Code:


	Code:
	'So the first line you are creating a list/matrix 
with a single row and defining it as arr terms. I don't really 
get what the Split and the l or all the brackets and asterisks 
and backslashes are doing though.
arrTerms = Split("(\<italics\>)(*)(\<italics/\>)|(\<bold\>)(*)(\<bold/\>)|(\<indent\>)(*)(\<indent/\>)", "|")
'Creating a loop which is based on variable IngIndex 
running through as many times as there are items in the list 
For lngIndex = 0 To UBound(arrTerms)
' Setting Range as whole document?  
Set wdRng = wdDoc.Range
    With wdRng.Find
'Find the term from the list for example <italics>and I start to very lost 
      .Text = arrTerms(lngIndex)
'I assume this means it has to be exact match
      .MatchWildcards = True
'Have no idea what is going on here cause I can't work out where 
you have actually selected the text between the two terms 
that is <italics> and <italics/>
      Select Case lngIndex
        Case 0: .Replacement.Font.Italic = True
        Case 1: .Replacement.Font.Bold = True
        Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
      End Select
'I believe this line deletes all the arrterms in the document 
but have no idea how or why or what "\2" is
      .Replacement.Text = "\2"
      .Execute Replace:=wdReplaceAll
   End With
"Goes to next in list
  Next

Would be great to understand it so I can use it in other instances for example I think I will need it for <tab> at some stage. Once again thanks heaps for all the help my project is really coming along.

macropod · #8 03-30-2016, 01:53 PM

To explain, I'll start with my own equivalent of Greg's code, as it's a little easier to see what's going on:

Code:

Sub FormatHTML(wdDoc As Document)
Dim arrTerms(), i As Long
arrTerms = Array("italics", "bold", "indent")
With wdDoc.Range.Find
    .MatchWildcards = True
    .Replacement.Text = "\3"
    For i = 0 To UBound(arrTerms)
        .Replacement.ClearFormatting
        .Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"
        Select Case i
            Case 0: .Replacement.Font.Italic = True
            Case 1: .Replacement.Font.Bold = True
            Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
        End Select
        .Execute Replace:=wdReplaceAll
    Next
End With
End Sub

The first line:
Sub FormatHTML(wdDoc As Document)
contains both the name of the subroutine and a reference to the document you want to process.

The line:
arrTerms = Array("italics", "bold", "indent")
defines an array containing three elements. In my code, those elements are just simple words; in Greg's, they're complete wildcard strings.

The lines:
For i = 0 To UBound(arrTerms)
...
Next
set up a loop that processes all the array elements.

The line:
.Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"
turns the array element into a wildcard expression that is the equivalent of the wildcard expression contained in Greg's array.

The block delineated by:
Select Case i
...
End select
tells the code what to use as a replacement parameter for the corresponding array element. The first item is Case 0, because 0 is the normal index number of the first entry in an array.

rpb925 · #9 03-30-2016, 04:41 PM

Ok getting a little clearer. Still bamboozled by the following

.Replacement.Text = "\3"
.Execute Replace:=wdReplaceAll

How does the replace work? what is \3 why does Greg use \2 and is this where the original tags are deleted?

.Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"

What is (*)\1/\2 doing it looks like jibberish?

gmaxey · #10 03-30-2016, 04:56 PM

I'll add a little to Paul's explanation and while I'm at it concede, as is typically the case, his code is more concise than mine.

RE the first line (and the declaration). Paul and I both used a VBA function to return an array (an array is sort of like a matrix or list). Paul used "Array" which returns a variant containing an array (the element could be strings, longs, doubles, whatever) and I used "Split" which returns a zero-based, one-dimensional array containing a specified number of substrings.

In the example below, my elements are "A, B and C" ("A|B|C")delimited using the "|" character.
I could have just as easily used "A,B,C" "," where the elements were delimited with a comma. In this case I don't see where either are more or less concise than the other and just a preference. Using Array, the elements could have been the strings A, B and C or longs 1, 2, 3 or whatever.

Code:

Sub ArraySplitDiff()
  Dim arr
  Dim arrString() As String
  arr = Array(1, 2, 3)
  arr = Array("A", "B", "C")
  arrString = Split("A|B|C", "|")
End Sub

In Paul’s mind boggling find wildcard expression, he has divided his expression into three groups. The groups are delineated using parens “()”

The first group defines the leading “<” and the term from the array. When using wildcards, some characters “are wildcard” characters so when you physically want to find the implicit character you precede it with “\”. So the first group looks for “<italics or <bold or <indent etc.

The second group defines the trailing “>”

The third group defines anything between the tags.

Where Paul dazzles, is when he follows the third group with the group number for the first group, the expression to find the “\” in the second half for the tag and the group number for the second group.

Naturally Paul then assigns the group 3 as the replacement text.

I had used three groups as well but in my expression group 2 was the part that defined everything between the tags.

Adding something else is simply at this point:

Code:

Sub Demo()
Dim arrTerms(), i As Long
arrTerms = Array("italics", "bold", "indent", "tab")
With ActiveDocument.Range.Find
    .MatchWildcards = True
    .Replacement.Text = "\3"
    For i = 0 To UBound(arrTerms)
        .Replacement.ClearFormatting
        .Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"
        Select Case i
            Case 0: .Replacement.Font.Italic = True
            Case 1: .Replacement.Font.Bold = True
            Case 2: .Replacement.ParagraphFormat.LeftIndent = 72
            Case 3: .Replacement.Text = Chr(9)
        End Select
        .Execute Replace:=wdReplaceAll
    Next
End With
End Sub

gmaxey · #11 03-30-2016, 05:06 PM

Type "apples cherries oranges" in a document. Using Find and replace with More>Use wildcards, type (apples)(*)(oranges) in the find what and \2 in the replace with. Click replace all.

You see in my code, group 2 defined anything between the tags and in Paul's it was group 3.

macropod · #12 03-30-2016, 05:12 PM

Quote:

Originally Posted by rpb925

.Replacement.Text = "\3"
.Execute Replace:=wdReplaceAll

How does the replace work? what is \3 why does Greg use \2 and is this where the original tags are deleted?

A wildcard Find can use brackets () to delineate certain segments of the expression for re-use. The Find expression:
.Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"
has 3 such delineated segments and it is the 3rd of these that gets re-used for the replacement. In Greg's code, there were just 2 such delineations and the 2nd gets reused.

Quote:

Originally Posted by rpb925

.Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"

What is (*)\1/\2 doing it looks like jibberish?

Not jibberish; just clever.

The:
(\<" & arrTerms(i) & ")(\>)
defines 2 segments of the Find expression for re-use: the string comprising the '<' and array entry for the 1st segment; and the '>' for the 2nd segment. A '\' is required before certain Find characters, including < and >.

The:
(*)
defines as a 3rd segment whatever follows the 2nd segment that precedes a repeat of the 1st segment, as indicated by the \1.

The:
\1/\2
says to repeat the 1st segment, insert the /, then repeat the 2nd segment.

FWIW:
.Text = "(\<" & arrTerms(i) & ")(\>)(*)\1/\2"
is the same as:
.Text = "\<" & arrTerms(i) & "\>(*)\<" & arrTerms(i) & "/\>"
for which the replacement would be \1.

rpb925 · #13 03-31-2016, 03:14 AM

Far out it's like a puzzle. Thanks heaps for the break down. I feel like I'm getting close to getting a grasp on it but I still need to re-read the explanation another couple of times sleep on it and muck around with both your codes. This example just showed me how many ways there are to do the same thing, I hadn't realized. I thought it would be alot more constrained but it's more like pick your own adventure. Thanks for the help.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Adding tables to Created word document whilst other word document open Help	rpb925	Word VBA	18	03-30-2016 04:45 PM
Uploading a previously created bibliography to be used in a new document	JennJenn79	Word	1	07-16-2015 09:34 PM
was document created using 2010 or 2013	TDOG	Word	1	10-12-2014 03:37 PM
Copy format created by a conditional formatting	spk	Excel	2	04-10-2013 04:41 AM
Word crashing on "sort" routine	Kayale	Word	0	04-12-2010 04:54 PM