none
Word 2007 VBA - Making some text BOLD & other ITALIC RRS feed

  • Question

  • I have the following code that selects data from an Excel Cell & replaces a specific piece of text in my Word document (for purposes of this question, the Excel Cell has been replaced by a plain text string).

    The data ": goes to " is constant, then the data "aaa bbb" can be anything until we reach the " of " which is also constant. Then the data after the " of ", "ccc ddd eee" can be anything until it hits the " - " which is also constant.

    Is it possible to make the "aaa bbb" data BOLD & UPPER CASE, whilst making the "ccc ddd eee" data into ITALICS ?

    ": goes to AAA BBB of ccc ddd eee - "

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV1"
        .Replacement.Text = ": goes to aaa bbb of ccc ddd eee - "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Selection.Find.Execute Replace:=wdReplaceAll

    Friday, February 8, 2013 4:09 PM

All replies

  • Build up the replace string by parts:

    Sub Macro1()
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV1"
        .Replacement.Text = ": goes to XYZZY"
        .MatchCase = True
        .Forward = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Bold = True
        With Selection.Find
            .Text = "XYZZY"
            .Replacement.Text = "AAA BBB XXYYZ"
            .MatchCase = True
            .Forward = True
            .Format = True
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Bold = False
        With Selection.Find
            .Text = "XXYYZ"
            .Replacement.Text = "of XXXYY"
            .Forward = True
            .Format = True
            .MatchCase = True
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Italic = True
        With Selection.Find
            .Text = "XXXYY"
            .Replacement.Text = "ccc ddd eee XXXXY"
            .Forward = True
            .MatchCase = True
            .Format = True
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "XXXXY"
            .Replacement.Text = " - "
            .MatchCase = True
            .Forward = True
            .Format = True
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
     
    End Sub

    Friday, February 8, 2013 10:54 PM
  • I think I would be inclined to use the following:

    Dim oRng As Range
    Dim oRepl As Range
        Set oRng = ActiveDocument.Range
        With oRng.Find
            Do While .Execute(FindText:="MOTMDIV1")
                Set oRepl = oRng
                oRepl.Text = ": goes to aaa bbb of ccc ddd eee - "
                Do Until Trim(oRepl.Words(1)) = "to"
                    oRepl.MoveStart wdWord
                Loop
                oRepl.MoveStart wdWord
                oRepl.End = oRepl.Start
                Do Until Trim(oRepl.Words.Last) = "of"
                    oRepl.MoveEnd wdWord
                Loop
                oRepl.MoveEnd wdWord, -1
                oRepl.Font.Bold = True

                Set oRepl = oRng
                Do Until Trim(oRepl.Words(1)) = "of"
                    oRepl.MoveStart wdWord
                Loop
                oRepl.MoveStart wdWord
                oRepl.End = oRepl.Start
                Do Until Trim(oRepl.Words.Last) = "-"
                    oRepl.MoveEnd wdWord
                Loop
                oRepl.MoveEnd wdWord, -1
                oRepl.Font.Italic = True
                oRng.Collapse wdCollapseEnd
            Loop
        End With


    Graham Mayor - Word MVP
    www.gmayor.com

    Saturday, February 9, 2013 9:16 AM
  • Bernie & Graham, sorry, I haven't forgotten you, I am stuck on another bit of code that is holding me up, I will get a look at these options soon & let you know how I get on, sorry & thanks !!!
    Tuesday, February 12, 2013 6:52 PM