Consulting

Results 1 to 6 of 6

Thread: Applying specific content control formatting, excluding certain words / punctuation

  1. #1
    VBAX Tutor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    267
    Location

    Applying specific content control formatting, excluding certain words / punctuation

    How would I allow the following Content Control formatting, but compile a string of words or characters that if present in the TextBox on a UserForm, were not included in the two lines of formatting intruction?

    For the vbProperCase I would like to exclude words like "the, and, it, if, so" so they would all be LowerCase if found.

    For the UCase Words, I need it to exclude commas and full stops (this is because at the moment, if one is found at the end of the text entry, it treats that as the last word and effectifly capitilises it instead of the real last actual word).

    Finally, if there is a hyphen immediately to the left of the vbProperCase selected last word, then the word to the left of the hyphen should also have UCase applied too.

    I'm thinking that this would probably involve producing three variable strings which contain the various words / punctuation marks combinations, then putting in some "If InStr, else, else if" code.

    (I've removed all the other Case select options from the below)

    Sub FillForm()
    
    Dim oCtrl       As Control
        Dim oCC         As ContentControl
        Dim oRng        As Range
        Dim lngIndex    As Long
        Dim strTC       As String
    
    With m_oFrm
            
            For Each oCtrl In .Controls
                
                Select Case TypeName(oCtrl)
                    Case "TextBox"
    
    If oCtrl.Name = "txtKeys" Then
                            Set oRng = ActiveDocument.SelectContentControlsByTag("Keys").Item(1).Range
                            oRng.Text = StrConv(oCtrl.Text, vbProperCase)
                            oRng.Words.Last = UCase(oRng.Words.Last)
    End If
    End Select
            Next oCtrl
        End With
    
    lbl_Exit:
        Exit Sub
    End Sub
    Thanks!
    Steve

  2. #2
    VBAX Regular
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    23
    Location
    You have oCC declared as a Content Control but do not use it. (I know it does not answer your question.)

  3. #3
    You could use a function such as a slightly modified version of the one on my web site https://www.gmayor.com/word_vba_examples_2.htm e.g.

    Sub FillForm()
    Dim oCtrl As Control
    Dim oRng As Range
    Dim m_oFrm As UserForm1
    
    
        Set m_oFrm = New UserForm1
        With m_oFrm
            .Show
            For Each oCtrl In .Controls
                If TypeName(oCtrl) = "TextBox" Then
                    Select Case oCtrl.Name
                        Case Is = "txtKeys"
                            'Set a range to the content control
                            Set oRng = ActiveDocument.SelectContentControlsByTitle("Keys").Item(1).Range
                            'Fill the range with the content of the text box
                            oRng.Text = oCtrl.Text
                            'Convert the range to true title case
                            TrueTitleCase oRng
                            'set the range to the last word in the control
                            Set oRng = ActiveDocument.SelectContentControlsByTitle("Keys").Item(1).Range.Words.Last
                            'make that last word upper case
                            oRng.Case = wdUpperCase
                        Case Else
                    End Select
                End If
            Next oCtrl
        End With
        Unload m_oFrm
    lbl_Exit:
        Set oCtrl = Nothing
        Set oRng = Nothing
        Set m_oFrm = Nothing
        Exit Sub
    End Sub
    
    
    Public Sub TrueTitleCase(oRng As Range)
    'Graham Mayor - https://www.gmayor.com - Last updated - 24 Mar 2021 
    Dim vFindText As Variant
    Dim vReplText As Variant
    Dim i As Long
    Dim k As Long
    Dim m As Long
        'count the characters in the selected string
        k = Len(oRng)
        If k < 1 Then
            'If none, then no string is selected
            'so warn the user
            MsgBox "Select the text first!", vbOKOnly, "No text selected"
            Exit Sub    'and quit the macro
        End If
        'format the selected string as title case
        oRng.Case = wdTitleWord
        'list the exceptions to look for in an array
        vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
                          "If", "In", "Of", "On", "Or", "The", "To", "With")
        'list their replacements in a matching array
        vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
                          "if", "in", "of", "on", "or", "the", "to", "with")
        With oRng
            With .Find
                'replace items in the first list
                'with the corresponding items from the second
                .ClearFormatting
                .Replacement.ClearFormatting
                .Forward = True
                .Wrap = wdFindStop
                .MatchWholeWord = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Format = True
                .MatchCase = True
                For i = LBound(vFindText) To UBound(vFindText)
                    .Text = vFindText(i)
                    .Replacement.Text = vReplText(i)
                    .Execute Replace:=wdReplaceAll
                Next i
            End With
            'Reduce the range of the selected text
            'to encompass only the first character
            .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
            'format that character as upper case
            .Case = wdUpperCase
            'restore the selected text to its original length
            .MoveEnd Unit:=wdCharacter, Count:=k
            'and check to see if the string contains a colon
            If InStr(1, oRng, ":") > 0 Then
                'If it does note the position of the character
                'after the first colon
                m = InStr(1, oRng, ":") + 1
                'and set that as the new start of the selected text
                .MoveStart wdCharacter, m
                'set the end of the selected text to include
                'one extra character
                .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
                'format that character as upper case
                .Case = wdUpperCase
            End If
        End With
    lbl_Exit:
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Tutor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    267
    Location
    Many thanks, Graham!

    Everything is working okay except for the conversion to uppercase for any word found before a hyphen.

    (I had to tweak your sub at first as it was looking for a colon and not a hyphen).

    For example, after running the sub, one should arrive at "Peter CONYERS-NORTON", whereas at the moment it produces "Peter Conyers-NORTON".

    Public Sub TrueTitleCase(oRng As Range)
        'Graham Mayor - https://www.gmayor.com - Last updated - 24 Mar 2021
        Dim vFindText As Variant
        Dim vReplText As Variant
        Dim i      As Long
        Dim k      As Long
        Dim m      As Long
        'count the characters in the selected string
        k = Len(oRng)
        If k < 1 Then
            'If none, then no string is selected
            'so warn the user
            MsgBox "Select the text first!", vbOKOnly, "No text selected"
            Exit Sub                                  'and quit the macro
        End If
        'format the selected string as title case
        oRng.Case = wdTitleWord
        'list the exceptions to look for in an array
        vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
        "If", "In", "Of", "On", "Or", "The", "To", "With")
        'list their replacements in a matching array
        vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
        "if", "in", "of", "on", "or", "the", "to", "with")
        With oRng
            With .Find
                'replace items in the first list
                'with the corresponding items from the second
                .ClearFormatting
                .Replacement.ClearFormatting
                .Forward = True
                .Wrap = wdFindStop
                .MatchWholeWord = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Format = True
                .MatchCase = True
                For i = LBound(vFindText) To UBound(vFindText)
                    .Text = vFindText(i)
                    .Replacement.Text = vReplText(i)
                    .Execute Replace:=wdReplaceAll
                Next i
            End With
            'Reduce the range of the selected text
            'to encompass only the first character
            .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
            'format that character as upper case
            .Case = wdUpperCase
            'restore the selected text to its original length
            .MoveEnd Unit:=wdCharacter, Count:=k
            'and check to see if the string contains a hyphen
            If InStr(1, oRng, "-") > 0 Then
                'If it does note the position of the character
                'after the first hyphen
                m = InStr(1, oRng, "-") + 1
                'and set that as the new start of the selected text
                .MoveStart wdCharacter, m
                'set the end of the selected text to include
                'one extra character
                .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
                'format that character as upper case
                .Case = wdUpperCase
            End If
        End With
    lbl_Exit:
        Exit Sub
    End Sub

  5. #5
    In that case you want
    Public Sub TrueTitleCase(oRng As Range)'Graham Mayor - https://www.gmayor.com - Last updated - 25 Mar 2021
    Dim vFindText As Variant
    Dim vReplText As Variant
    Dim i As Long
    Dim k As Long
    Dim m As Long
    
    
        'count the characters in the selected string
        k = Len(oRng)
        If k < 1 Then
            'If none, then no string is selected
            'so warn the user
            MsgBox "Select the text first!", vbOKOnly, "No text selected"
            Exit Sub    'and quit the macro
        End If
        'format the selected string as title case
        oRng.Case = wdTitleWord
        'list the exceptions to look for in an array
        vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
                          "If", "In", "Of", "On", "Or", "The", "To", "With")
        'list their replacements in a matching array
        vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
                          "if", "in", "of", "on", "or", "the", "to", "with")
        With oRng
            With .Find
                'replace items in the first list
                'with the corresponding items from the second
                .ClearFormatting
                .Replacement.ClearFormatting
                .Forward = True
                .Wrap = wdFindStop
                .MatchWholeWord = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Format = True
                .MatchCase = True
                For i = LBound(vFindText) To UBound(vFindText)
                    .Text = vFindText(i)
                    .Replacement.Text = vReplText(i)
                    .Execute Replace:=wdReplaceAll
                Next i
            End With
            'Reduce the range of the selected text
            'to encompass only the first character
            .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
            'format that character as upper case
            .Case = wdUpperCase
            'restore the selected text to its original length
            .MoveEnd Unit:=wdCharacter, Count:=k
            'and check to see if the string contains a colon
            If InStr(1, oRng, ":") > 0 Then
                'If it does note the position of the character
                'after the first colon
                m = InStr(1, oRng, ":") + 1
                'and set that as the new start of the selected text
                .MoveStart wdCharacter, m
                'set the end of the selected text to include
                'one extra character
                .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
                'format that character as upper case
                .Case = wdUpperCase
            End If
            If InStr(1, oRng, "-") > 0 Then
                'If it does note the position of the character
                'after the first hyphen
                m = InStr(1, oRng, "-") - 1
                'and set that as the new start of the selected text
                .MoveStart wdCharacter, m
                'collapse to the start of the hyphen
                .Collapse 1
                'move the start to the start of the previous word
                .MoveStart wdWord, -1
                'set the end of the selected text to include
                'the word following the hyphen
                .MoveEnd Unit:=wdWord, Count:=2
                'format that character as upper case
                .Case = wdUpperCase
            End If
    
    
        End With
    lbl_Exit:
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    VBAX Tutor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    267
    Location
    Spot on, many thanks Graham!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •