Code:
Private Sub Export_Click()
Dim objWord As Word.Application
Dim doc As Word.Document
Dim myrange As Range
Dim CCTitle As String
Dim CCText As String
CCTitle = Forms!frm_StandardConCheckEdit!ConditionTitle
CCText = Forms!frm_StandardConCheckEdit!ConditionText
'Open Word
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = True
Set doc = .Documents.Add
doc.SaveAs CurrentProject.Path & "\TestDoc.doc"
End With
'Title/IntroPage
With objWord.Selection
.Font.Name = "Arial"
.Font.Size = 10
.Font.Bold = True
.Font.Italic = False
.TypeText Text:=CCTitle
.TypeParagraph
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CCText
End With
'INDENT
'Format Word Document
With objWord
'Move selection 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 objWord.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 = objWord.Selection.Range 'Setting property of range
myrange.End = objWord.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 objWord.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LeftIndent = objWord.CentimetersToPoints(2)
.FirstLineIndent = objWord.CentimetersToPoints(-1)
End With
objWord.Selection.MoveRight Unit:=wdCharacter, Count:=1
'Loop to next
Loop
End With
'BOLD
'Restart at beggining
With objWord
.Selection.HomeKey wdStory
.Selection.Find.ClearFormatting
End With
'Define Range
With objWord.Selection.Find
Do While .Execute(FindText:="<bold>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = objWord.Selection.Range
myrange.End = objWord.ActiveDocument.Range.End
myrange.End = myrange.Start + InStr(myrange, "<bold/>")
myrange.Select
'format
With objWord.Selection.Font
.Bold = True
End With
objWord.Selection.MoveRight Unit:=wdCharacter, Count:=1
'Loop to next
Loop
End With
'ITALICS
With objWord
.Selection.HomeKey wdStory
.Selection.Find.ClearFormatting
End With
'Define Range
With objWord.Selection.Find
Do While .Execute(FindText:="<italics>", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True
Set myrange = objWord.Selection.Range
myrange.End = objWord.ActiveDocument.Range.End
myrange.End = myrange.Start + InStr(myrange, "<italics/>")
myrange.Select
'format
With objWord.Selection.Font
.Italic = True
End With
objWord.Selection.MoveRight Unit:=wdCharacter, Count:=1
'Loop to next
Loop
End With
'Delete formating symbols
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<indent>"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll, Forward:=False, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<indent/>"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<bold>"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<bold/>"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<italics>"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<italics/>"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
objWord.Selection.WholeStory
With objWord.Selection.Find
.ClearFormatting
.Text = "<tab>"
.Replacement.ClearFormatting
.Replacement.Text = vbTab
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
objWord.Selection.HomeKey wdStory
Set objWord = Nothing
End Sub