Content Control text formatting

[Gregory K. Maxey]

The other day someone asked me how to link 4 content controls such that the
text in one would be lower case, one upper case, one title case and one
sentence case.

I couldn't figure out how to do this using the normal XML mapping method so
I thought I would try using the ContentControlOnExit event.

I entered the four controls and assigned each one the title "Test", I tagged
the controls "LC" "UC" "TC" and "SC." I tried using the following code and
all worked except for the Case Is SC part.

Private Sub Document_ContentControlOnExit(ByVal ContentControl As
ContentControl, Cancel As Boolean)
Dim oCC1 As ContentControl
Dim pStr As String
pStr = ContentControl.Range.Text
For Each oCC1 In ActiveDocument.ContentControls
If oCC1.Title = "Test" Then
Select Case oCC1.Tag
Case Is = "LC"
oCC1.Range.Text = LCase(pStr)
Case Is = "UC"
oCC1.Range.Text = UCase(pStr)
Case Is = "TC"
oCC1.Range.Text = pStr
oCC1.Range.Case = wdTitleWord
Case Is = "SC"
oCC1.Range.Text = pStr
oCC1.Range.Case = wdTitleSentence
End Select
End If
Next
End Sub

For some reason the text of a ContentControl can not be set to senctence
case using VBA. I confirmed this by selecting the text in a CC and running
the following code:

Sub Test()
Selection.Range.ContentControls(1).Range.Case = wdUpperSentence
End Sub

As a work around, I added a bookmark at the end of the document. I put the
CC text in the bookmark, formatted it, and then put the formatted text back
in CC as shown below. Does anyone know why the text can't be formatted
directly as in the other cases?

Thanks.

Private Sub Document_ContentControlOnExit(ByVal ContentControl As
ContentControl, Cancel As Boolean)
Dim oCC1 As ContentControl
Dim oBMs As Bookmarks
Set oBMs = ActiveDocument.Bookmarks
Dim pStr As String
Dim oRng As Word.Range
pStr = ContentControl.Range.Text
For Each oCC1 In ActiveDocument.ContentControls
If oCC1.Title = "Test" Then
Select Case oCC1.Tag
Case Is = "LC"
oCC1.Range.Text = LCase(pStr)
Case Is = "UC"
oCC1.Range.Text = UCase(pStr)
Case Is = "TC"
oCC1.Range.Text = pStr
oCC1.Range.Case = wdTitleWord
Case Is = "SC"
Set oRng = oBMs("ScratchPad").Range
oRng.Text = pStr
oBMs.Add "ScratchPad", oRng
oBMs("ScratchPad").Range.Case = wdTitleSentence
pStr = oBMs("ScratchPad").Range.Text
oCC1.Range.Text = pStr
oRng.Text = ""
oBMs.Add "ScratchPad", oRng
End Select
End If
Next
End Sub

 

[alborg]

Hi Greg!

Try this to get the "sentence text" formatting-

'-------------------------------------------------------
Sub aDone()
Dim strText As String, ii As Long, xx As String, yy As String, zz As String,
tt As String
MsgBox Selection.Text
'MsgBox "Length of Selected Text: " & Len(Selection.Text)
'MsgBox Selection.Words.Count & " words are selected"
yy = Selection.Text
strText = ""
For ii = 1 To Len(yy)
tt = Mid(yy, ii, 1)
If xx = "cap" And zz = "cap" Then
tt = UCase(Mid(yy, ii, 1))
zz = "small"
Else
tt = Mid(yy, ii, 1)
End If
If Mid(yy, ii, 1) = "." Then
xx = "cap"
Else
If Mid(yy, ii, 1) <> " " Then
xx = "small"
End If
End If
If Mid(yy, ii, 1) = " " Then
zz = "cap"
Else
zz = "small"
End If
strText = IIf(IsNull(strText) Or strText = "", UCase(Left(yy, 1)),
strText & tt)
Next ii
Selection.Text = strText
Exit Sub
End Sub
'-------------------------------------------------------

I tested it and it seems to work well.

Cheers,
Al

 

[Gregory K. Maxey]

Al,

No that didn't work all the time, but modified to this it seems to be
working:

Function aDone(yy As String) As String
Dim pStr As String, i As Long, xx As String, tt As String
pStr = ""
xx = "cap"
For i = 1 To Len(yy)
tt = Mid(yy, i, 1)
If xx = "cap" And tt Like "[A-Za-z]" Then
tt = UCase(Mid(yy, i, 1))
xx = "small"
Else
tt = LCase(Mid(yy, i, 1))
End If
If InStr("!.?", Mid(yy, i, 1)) > 0 Then
xx = "cap"
End If
pStr = IIf(IsNull(pStr) Or pStr = "", UCase(Left(yy, 1)), pStr & tt)
Next i
aDone = pStr
End Function

Called from the OnExit like this:
Case Is = "SC"
oCC1.Range.Text = aDone(pStr)
End Select

 

[alborg]

Great!

Al,

No that didn't work all the time, but modified to this it seems to be
working:

Function aDone(yy As String) As String
Dim pStr As String, i As Long, xx As String, tt As String
pStr = ""
xx = "cap"
For i = 1 To Len(yy)
tt = Mid(yy, i, 1)
If xx = "cap" And tt Like "[A-Za-z]" Then
tt = UCase(Mid(yy, i, 1))
xx = "small"
Else
tt = LCase(Mid(yy, i, 1))
End If
If InStr("!.?", Mid(yy, i, 1)) > 0 Then
xx = "cap"
End If
pStr = IIf(IsNull(pStr) Or pStr = "", UCase(Left(yy, 1)), pStr & tt)
Next i
aDone = pStr
End Function

Called from the OnExit like this:
Case Is = "SC"
oCC1.Range.Text = aDone(pStr)
End Select

Hi Greg!

Try this to get the "sentence text" formatting-

'-------------------------------------------------------
Sub aDone()
Dim strText As String, ii As Long, xx As String, yy As String, zz As
String, tt As String
MsgBox Selection.Text
'MsgBox "Length of Selected Text: " & Len(Selection.Text)
'MsgBox Selection.Words.Count & " words are selected"
yy = Selection.Text
strText = ""
For ii = 1 To Len(yy)
tt = Mid(yy, ii, 1)
If xx = "cap" And zz = "cap" Then
tt = UCase(Mid(yy, ii, 1))
zz = "small"
Else
tt = Mid(yy, ii, 1)
End If
If Mid(yy, ii, 1) = "." Then
xx = "cap"
Else
If Mid(yy, ii, 1) <> " " Then
xx = "small"
End If
End If
If Mid(yy, ii, 1) = " " Then
zz = "cap"
Else
zz = "small"
End If
strText = IIf(IsNull(strText) Or strText = "", UCase(Left(yy, 1)),
strText & tt)
Next ii
Selection.Text = strText
Exit Sub
End Sub
'-------------------------------------------------------

I tested it and it seems to work well.

Cheers,
Al