Macro to insert symbols before and after selection and apply style

[bstephens]

Hi, suppose I had the following text:


Except as disclosed in Schedule 1.1 Permitted Exceptions
and I want a macro that will be a one button press to turn it into this:


Except as disclosed in Schedule 1.1 ("Permitted Exceptions")
Where the words "Permitted Exceptions" are actually a style I created called "Defined Term" (instead of just regular underlining).

I created this macro as a start:

Sub CreateDefinedTerm()
Selection.Style = ActiveDocument.Styles("Defined Term")
Selection.InsertBefore "("""
Selection.InsertAfter """)"
End Sub
However, my macro doesn't give the result I expected because it inserts "straight quotes" instead of "smart quotes". Also, it is not smart about the selection because if I double click on a word it also selects the trailing space.

Does anyone know a way to revise the macro above so that it will:

1. Insert smart quotes instead of straight quotes, and,
2. Be smart about applying the "Defined Term" style, by applying it only to the word and not the parenthesis or quotes (regardless of whether it was double clicked on so that the trailing space is also selected or if the user goes through the trouble to exactly select it)

Thanks for your input ;)

Best,
Brian

[bstephens]

Ok, so I found someone already created the "smart select" concept and the "smart quotes" concept

Sub addquotes()
Dim r As Range
With ActiveDocument
'check for extra spaces and punctuation &
'select the entire word or phrase
Set r = Selection.Words(Selection.Words.Count)
If r.Characters(r.Characters.Count) = " " Then
Set r = .Range(Selection.Words(1).Start, _
Selection.Words(Selection.Words.Count).End - 1)
Else
Set r = .Range(Selection.Words(1).Start, r.End)
End If
'check to see if AutoformatasYouType is being used
If Options.AutoFormatAsYouTypeReplaceQuotes Then
r.InsertBefore Chr(147)
r.InsertAfter Chr(148)
Else
r.InsertBefore Chr(34)
r.InsertBefore Chr(34)
End If
End With
' select the results as reference...can be commented if not needed
r.Select
End Sub
So, I should revise my question to:

How do I modify the above to also apply my style called "Defined Term" to the text between the quotes which is the result of the macro above?

[gmaxey]

Try:

Sub addquoteswithstyle()
Dim r As Range
'Omit leading and trailing spaces
Set r = Selection.Words(Selection.Words.Count)
Do While r.Characters(r.Characters.Count) = " "
r.MoveEnd wdCharacter, -1
Loop
Do While r.Characters(1) = " "
r.MoveEnd wdCharacter, 1
Loop
'Check to see if AutoformatasYouType is being used
If Options.AutoFormatAsYouTypeReplaceQuotes Then
r.InsertBefore Chr(147)
r.InsertAfter Chr(148)
Else
r.InsertBefore Chr(34)
r.InsertBefore Chr(34)
End If
r.Style = "Strong" 'replace with your style.
'If you want the quotes formated as well then use:
'r.MoveEnd wdCharacter, 1
'r.MoveStart wdCharacter, -1
'r.Style = "Strong"
End Sub

[bstephens]

Thanks Greg, that worked and applied the style, but do you know how to revise it so that it will apply the style to the text between the quotes (not including the quotes)?

[gmaxey]

Sure. Sorry I didn't test very well.

Sub addquoteswithstyle()
Dim oRng As Range
'Omit leading and trailing spaces
Set oRng = Selection.Range
With oRng
Do While .Characters(.Characters.Count) = " "
.MoveEnd wdCharacter, -1
Loop
Do While .Characters(1) = " "
.MoveStart wdCharacter, 1
Loop
'Check to see if AutoformatasYouType is being used
If Options.AutoFormatAsYouTypeReplaceQuotes Then
.InsertBefore Chr(147)
.InsertAfter Chr(148)
Else
.InsertBefore Chr(34)
.InsertBefore Chr(34)
End If
'If you want to exclude the quotes in formatting use:
.MoveEnd wdCharacter, -1
.MoveStart wdCharacter, 1
.Style = "Strong"
'If you want the quotes formated as well then use:
'.Style = "Strong" 'replace with your style.
End With
End Sub