VBA: Set two styles in one sentence

jeffreybrown · #1 08-18-2018, 08:30 PM

Is it possible to have a VBA routine check a sentence and add two styles.

With the string below, the part before the first comma should be bold, and the part between the first and second comma should be italics.

Before
AFC 39-101, A Reference book, 23 August 2018
DAB 10-211, Automotive Manual, 16 January 2009

After
AFC 39-101, A Reference book, 23 August 2018
DAB 10-211, Automotive Manual, 16 January 2009

gmayor · #2 08-18-2018, 08:53 PM

Assuming each reference reflects a paragraph then put the cursor in the paragraph and the following will apply built in character styles top the relative parts of the paragraph.

Code:

Sub FormatReferencePara()
Dim oRng As Range
Dim oStart As Range
    Set oStart = Selection.Range
    Set oRng = Selection.Paragraphs(1).Range
    oRng.Collapse 1
    oRng.MoveEndUntil Chr(44)
    oRng.End = oRng.End + 1
    oRng.Style = "Strong"
    oRng.Collapse 0
    oRng.MoveEndUntil Chr(44)
    oRng.End = oRng.End + 1
    oRng.Style = "Subtle Emphasis"
    oStart.Select
lbl_Exit:
    Set oRng = Nothing
    Set oStart = Nothing
    Exit Sub
End Sub

jeffreybrown · #3 08-19-2018, 06:46 AM

Thanks Graham. This works great.

It did not appear that this macro was looping thru the entire selection, so I did my best to update it to a For next statement and this seems to work great.

I didn't want the comma's to take on the applied format, so I removed the oRng.End part.

All seems to work well and I appreciate your time.

Code:

Sub FormatReferencePara()
    Dim oPara   As Paragraph
    Dim oRng    As Range
    Dim oSel    As Range
    
    Set oSel = Selection.Range
    
    For Each oPara In oSel.Paragraphs
        Set oRng = oPara.Range
        oRng.Collapse 1
        oRng.MoveEndUntil Chr(44)
'        oRng.End = oRng.End
        oRng.Style = "Strong"
        oRng.Collapse 0
        oRng.MoveEndUntil Chr(44)
'        oRng.End = oRng.End
        oRng.Style = "Subtle Emphasis"
        oSel.Select
    Next oPara
    
lbl_Exit:
    Set oRng = Nothing
    Set oSel = Nothing
    Exit Sub

End Sub

jeffreybrown · #4 09-07-2018, 02:19 PM

So apparently I don't understand the parts in blue. This code is applying the character styles to the commas also. I thought the parts in blue were formatting the commas also, but apparently not.

1) How can I stop the commas from retaining the character styles applied by the code?
2) How can the code skip the paragraph if the number of commas does not equal two?

Before
AFC 39-101, A Reference book, 23 August 2018
DAB 10-211, Automotive Manual, 16 January 2009
XYZ 39-101, Instruction cards
XYZ 39-101, Volume 1, Instruction cards, 23 December 2015

After
AFC 39-101, A Reference book, 23 August 2018
DAB 10-211, Automotive Manual, 16 January 2009
XYZ 39-101, Instruction cards (no format < 2 commas)
XYZ 39-101, Volume 1, Instruction cards, 23 December 2015 (no format > 2 commas)

Code:

Sub FormatReferencePara()
    Dim oPara   As Paragraph
    Dim oRng    As Range
    Dim oSel    As Range
    Set oSel = Selection.Range
    For Each oPara In oSel.Paragraphs
        Set oRng = oPara.Range
        oRng.Collapse 1
        oRng.MoveEndUntil Chr(44)
        oRng.End = oRng.End + 1
        oRng.Style = "Strong"
        oRng.Collapse 0
        oRng.MoveEndUntil Chr(44)
        oRng.End = oRng.End + 1
        oRng.Style = "Subtle Emphasis"
        oSel.Select
    Next oPara
lbl_Exit:
    Set oRng = Nothing
    Set oSel = Nothing
    Exit Sub
End Sub

macropod · #5 09-07-2018, 03:30 PM

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[A-Z]{3} [0-9]{2}-[0-9]{3},[!^13]@[0-9]{4}^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If Len(Replace(.Text, ",", "")) = Len(.Text) - 2 Then
      With .Duplicate
        .End = .Start + InStr(.Text, ",") - 1
        .Style = "Strong"
      End With
      With .Duplicate
        .Start = .Start + InStr(.Text, ",") + 1
        .End = .Start + InStrRev(.Text, ",") - 1
        .Style = "Emphasis"
      End With
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

jeffreybrown · #6 09-07-2018, 03:40 PM

That works great Paul. Thanks.

macropod · #7 09-07-2018, 03:46 PM

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Does a new set of styles in a template overwrite or remove the existing set of styles in a document?	dianahbr	Word	6	03-27-2018 11:12 PM
Two much blank space between names of styles in the Styles Pane	PereCasanellas	Word	0	10-06-2017 03:47 AM
Question about spacing between multi-level bullet styles (and other styles)	SDwriter	Word	0	09-26-2017 09:39 AM
Delete does not bring second sentence closer to first sentence	Andoheb	Word	29	07-03-2014 01:48 PM
Quick Styles Set saved but it doesnt appear at the styles list!	Pedro77	Word	3	10-15-2011 05:17 AM