Entered Text On UserForm Not Filling CC On Document

I'm trying to produce what ought to be the simplest of forms. There is a UserForm with one textbox (at the moment) that should populate the CC named PPN1 on the document, but will be formatted so that everything will be in proper case (Capital letter at the start of each sentence and all the other words in lower case).

I cannot tell if the proper case is working as the entered text will not even populate the document.

It must be something so simple that I just cannot see it. :banghead:

The necessity of the form is that the source text will be copied / pasted from multiple sources, some of which will be all upper case, some all lower case and crazily, some of a complete mixture.

Okay, so I have solved my UserForm not placing the text on the page.

Missed the second line as per below in bold.

Code:

---

For Each occ In oDoc.ContentControls
            Set oRng = occ.Range

---

Just struggling to get the text to format correctly.

This line makes every word capitalize.

Code:

---

oRng.Text = StrConv(.txtPPN1.Text, vbProperCase)

---

Fixed! See attached.

That, Graham, is absolutely brilliant!! Many, many thanks!!!

I followed the use of

Code:

---

wdTitleSentence

---

and can see that this preps things.

But the modPopupMenu is just something else! You sir, are a total VBA guru!! :bow:

I love the way that it will keep any alterations made within the UserForm, but will still tidy things if the entered text contains random uppercase/lowercase letters for example, if they happen in the wrong place. The only thing that one needs to get in their head is the lack of paragraphs on the UserForm and that if you produce one yourself, this will translate as a double paragraphed entry on the document. This is soon adopted and is not an issue.

Are there any limitations that you are aware of?

Thanks again!
Steve

The pop-up is a documented code from the internet. I take no credit for producing it, though I did amend it for 64 bit compatibility.
Use an appropriate style to add spacing between paragraphs. If you are troubled by double paragraph breaks you could replace them e.g.

Code:

---

oRng.Text = .txtPPN1.Text
oRng.Text = Replace(oRng.Text, Chr(13) & Chr(13), Chr(13))

---

Absolutely spot on, thank you.

It's really strange that when performing your own testing at home, everything seems to work okay. But take it into a work environment and the results are less predicatable. Totally frustrating!

What's worse is that it is difficult to establish why there are differing results.

Looking acrosss the internet, I came across this link

https://www.vbforums.com/showthread....ase-in-Textbox

I am not sure how the suggestions might work if they could be adapted or whether any of these might help my problem?

The sample was based on the settings I have here which has an assortment of object libraries checked that will be irrelevant to the template and may not even be available to your users. Check VBA tools > references and disable them one at a time and ensure that it still works.
If that doesn't address the problem what are the differing results your users are finding? There is nothing complicated about your template.

The form is just being used by myself at the moment so that I could use it for a bit and check for any possible issues.

I've done as you have suggested and now have just the 'Visual Basic for Applications', 'Microsoft Word 16 Object Library' and 'Microsoft Forms 2' references enabled. There was only the 'OLE Automation' and 'Microsoft Office 16' references that I've removed that still allows the form to run.

I shall report back on my findings after a few more days of usage.

On the whole this seems to be working okay. There is one thing that I have noticed in that when one clicks the "Edit Document" ribbon button, all the text bunches together on the UserForm and doesn't maintain the paragraph spacing. Click "Enter" again and the paragraphs show correctly on the document.

When copying the finished text from the document and pasting into our bespoke system that accepts RTF format, the paragraphs disappear as per that in the UserForm. Really strange!

Whilst looking at the formatting, is there a way to ensure that there is only a single space between words and no blank spaces at the start of any paragraph? You'd be surprised how many pieces of copied / pasted text has extra spaces or blank spaces at start of any paragraph. I think there are some people that type so quickly that they are unable to control word spacing!

Thanks!

I think I've found the answer to the single spacing between words part of my query in #10.

Code:

---

                    ' Ensure there is only single spacing between words
                        With oRng.Find
                            .ClearFormatting
                            .Replacement.ClearFormatting
                            'Here is where it is actually looking for spaces between words
                            .Text = " [ ]@([! ])"
                            'This line tells it to replace the excessive spaces with one space
                            .Replacement.Text = " \1"
                            .MatchWildcards = True
                            .Wrap = wdFindStop
                            .Format = False
                            .Forward = True
                            .Execute Replace:=wdReplaceAll
                        End With

---

I've now managed to (I think) tackle the single word spacing and remove empty paragraphs at the start and end.

Only bit now is when pressing the "Edit Document" ribbon button, all the text bunches together on the UserForm and doesn't maintain the paragraph spacing. Click "Enter" again and the paragraphs show correctly on the document.

When copying the finished text from the document and pasting into our bespoke system that accepts RTF format, the paragraphs disappear as per that in the UserForm like this:-

Chancellor Alexander Schallenberg said it would last a maximum of 20 days and there would be a legal requirement to get vaccinated from 1 February 2022.
He was responding to record case numbers and one of the lowest vaccination levels in Western Europe.
Many other European countries are imposing restrictions as cases rise.
"We don't want a fifth wave," said Mr Schallenberg after meeting the governors of Austria's nine provinces at a resort in the west of the country.
For a long time, there had been a consensus over avoiding mandatory vaccinations, the chancellor said.
However, too many people had been incited not to get the jab, because of "too many political forces, flimsy vaccination opponents and fake news", he added. The measures are yet to be finalised.

Code:

---

Option Explicit

Sub CreateDoc()
    Dim oDoc  As Document
    Dim oRng  As Range
    Dim oRngPara As Range
    Dim oCC    As ContentControl
    Dim oFrmPPN1 As frmPPN1

    If ActiveDocument = ThisDocument Then
        MsgBox "You cannot use this function to edit the document template", vbCritical
        Exit Sub
    End If
   
    Set oDoc = ActiveDocument
    Set oFrmPPN1 = New frmPPN1
    With oFrmPPN1
       
        For Each oCC In oDoc.ContentControls
            If oCC.ShowingPlaceholderText = False Then
                Select Case oCC.Title
                    Case "PPN1"
                        .txtPPN1.Text = oCC.Range.Text
                End Select
            End If
        Next oCC
       
        .Show
        If .Tag = 0 Then GoTo lbl_Exit
       
        For Each oCC In oDoc.ContentControls
            'Set a range to the content control
            Set oRng = oCC.Range
           
            Select Case oCC.Title
                Case "PPN1"
                    'Fill the range with the content of the text box
                    oRng.Text = .txtPPN1.Text
                   
                    Application.ScreenUpdating = False
                   
                    ' Ensure there is only single spacing between words
                    With oRng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        'Here is where it is actually looking for spaces between words
                        .Text = " [ ]@([! ])"
                        'This line tells it to replace the excessive spaces with one space
                        .Replacement.Text = " \1"
                        .MatchWildcards = True
                        .Wrap = wdFindStop
                        .Format = False
                        .Forward = True
                        .Execute Replace:=wdReplaceAll
                    End With
                   
                    ' Ensure there is only single line spacing between paragraphs
                    With oRng.Find
                        .MatchWildcards = True
                        .Text = "[^13]{2,}"
                        .Replacement.Text = "^p"
                        .Execute Replace:=wdReplaceAll
                        .Text = "[^l]{2,}"
                        .Replacement.Text = "^l"
                        .Execute Replace:=wdReplaceAll
                        .Text = "[^13^l]{2,}"
                        .Replacement.Text = "^p"
                        .Execute Replace:=wdReplaceAll
                    End With
                   
                    'Convert to sentence case
                    oRng.Case = wdTitleSentence
                   
                    ' Ensure any first or last empty paragraphs are removed
                    Set oRngPara = ActiveDocument.Paragraphs(1).Range
                    If oRngPara.Text = vbCr Then oRngPara.Delete
                   
                    Set oRngPara = ActiveDocument.Paragraphs.Last.Range
                    If oRngPara.Text = vbCr Then oRngPara.Delete
                   
                    Application.ScreenUpdating = True
                   
            End Select
        Next oCC
    End With
   
lbl_Exit:
    Unload oFrmPPN1
    Set oFrmPPN1 = Nothing
    Set oRng = Nothing
    Set oRngPara = Nothing
    Set oCC = Nothing
    Set oDoc = Nothing
    Exit Sub
End Sub

---

Getting really close now. Only issue is if there are extra empty paragraphs at the end, the code fails with a Runtime Error 5941: The requested member of the collection does not exist on this line

Code:

---

If oRng.Paragraphs(x).Range.Text = vbCr And oRng.Paragraphs(x - 1).Range.Text = vbCr Then

---

Here is the full code that has also solved the "missing" paragraphs issue.

Code:

---

Option Explicit

Sub CreateDoc()
    Dim oDoc  As Document
    Dim oRng  As Range
    Dim oRngPara As Range
    Dim oParagraphCount As Long
    Dim x      As Integer
    Dim oCC    As ContentControl
    Dim oFrmPPN1 As frmPPN1

    If ActiveDocument = ThisDocument Then
        MsgBox "You cannot use this function to edit the document template", vbCritical
        Exit Sub
    End If
   
    Set oDoc = ActiveDocument
    Set oFrmPPN1 = New frmPPN1
    With oFrmPPN1
       
        For Each oCC In oDoc.ContentControls
            If oCC.ShowingPlaceholderText = False Then
                Select Case oCC.Title
                    Case "PPN1"
                        .txtPPN1.Text = oCC.Range.Text
                End Select
            End If
        Next oCC
       
        .Show
        If .Tag = 0 Then GoTo lbl_Exit
       
        For Each oCC In oDoc.ContentControls
            'Set a range to the content control
            Set oRng = oCC.Range
           
            Select Case oCC.Title
                Case "PPN1"
                    'Fill the range with the content of the text box
                    oRng.Text = .txtPPN1.Text
                   
                    Application.ScreenUpdating = False
                   
                    ' Ensure there is only single spacing between words
                    With oRng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        'Here is where it is actually looking for spaces between words
                        .Text = " [ ]@([! ])"
                        'This line tells it to replace the excessive spaces with one space
                        .Replacement.Text = " \1"
                        .MatchWildcards = True
                        .Wrap = wdFindStop
                        .Format = False
                        .Forward = True
                        .Execute Replace:=wdReplaceAll
                    End With
                   
                    ' Ensure there is only single paragraph spacing
                    oParagraphCount = oDoc.Paragraphs.Count
                   
                    'Loop Through Each Paragraph (in reverse order)
                    For x = oParagraphCount To 1 Step -1
                        If x - 1 > 1 Then
                            If oRng.Paragraphs(x).Range.Text = vbCr And oRng.Paragraphs(x - 1).Range.Text = vbCr Then
                                oRng.Paragraphs(x).Range.Delete
                            End If
                        End If
                    Next x

                    'Convert to sentence case
                    oRng.Case = wdTitleSentence
                   
                    ' Ensure any first or last empty paragraphs are removed
                    Set oRngPara = oDoc.Paragraphs(1).Range
                    If oRngPara.Text = vbCr Then oRngPara.Delete
                   
                    Set oRngPara = oDoc.Paragraphs.Last.Range
                    If oRngPara.Text = vbCr Then oRngPara.Delete
                   
                    Application.ScreenUpdating = True
                   
            End Select
        Next oCC
    End With
   
lbl_Exit:
    Unload oFrmPPN1
    Set oFrmPPN1 = Nothing
    Set oRng = Nothing
    Set oRngPara = Nothing
    Set oCC = Nothing
    Set oDoc = Nothing
    Exit Sub
End Sub

---

Maybe

Code:

---

Case "PPN1"
                oCC.LockContentControl = False
                oCC.LockContents = False
                oRng.Text = .txtPPN1.Text
                With oRng.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    'Here is where it is actually looking for spaces between words
                    .Text = "[ ]{1,}"
                    'This line tells it to replace the excessive spaces with one space
                    .Replacement.Text = " "
                    .MatchWildcards = True
                    .Wrap = wdFindStop
                    .Format = False
                    .Forward = True
                    .Execute Replace:=wdReplaceAll
                End With
                'Loop Through Each Paragraph (in reverse order)
                For x = oRng.Paragraphs.Count To 1 Step -1
                    If Len(oRng.Paragraphs(x).Range) = 1 Then oRng.Paragraphs(x).Range.Delete
                Next x
                oRng.Paragraphs.Last.Range.Characters.Last.Delete
                'Convert to sentence case
                oRng.Case = wdTitleSentence

---

Sorry, Graham, this does not remove the preceding or end empty paragraphs. The same error pops up. :(

It also loses the paragraph spacing where there is text.

It works for me - see attached.
I am appalled to see that your quote has materialised in Austria. It is interesting to note that the last time such an action was taken, it was by the last memorable Austrian, and look where that led. Here in Cyprus our president plans the same outrageous approach. This is not going to address the problem or end well. May I suggest that you listen to last night's comment by Neil Oliver on GB News.

Graham, I think I need to explain that the piece of text that I used was as a quick copy of a main news item on the BBC website and was used purely to demonstrate my problem and nothing else. Thinking about my choice of text now I had probably inadvertedly broken a forum rule by posting something political. I humbly and respectfully apologise if this is the case.

Alas, I am still not achieving the right results. I have managed to sort out any blank paragraphs at the start of anything pasted, but any end paragraphs I cannot deal with and have had to comment out the two lines of code.

To perform the removal of empty paragraphs at the beginning I've used a loop and this appears to function well. I've attached my latest offering.

Here are two images which show the ideal finished product (again I have used a BBC news article, although have avoided politics).

Attachment 29174Attachment 29175

Your latest effort adds empty paragraphs to the document which is bad practice. Use paragraph spacing. If you want to display spacing in the text box when using the edit button, you can do that by adding the empty paragraphs to the text box as you read back the content of the content control. See attached.

Many thanks Graham, that's cracked it! :thumb

I'd love to know what the following two lines of code do with regard to the Content Controls.

Code:

---

oCC.LockContentControl = False
                    oCC.LockContents = False

---

Also trying to fathom how this line works.

Code:

---

oRng.Paragraphs.Last.Range.Characters.Last.Delete

---

Am I right in saying that it looks at the last paragraph and then for any characters it might contain before deleting anything found?

Some edits are not possible if content controls or their contents are locked. The first two lines simply ensure they are not locked before attempting the edit. You can lock them after processing if you don't want users to meddle.
https://www.gmayor.com/insert_content_control_addin.htm is a simple means of inserting content controls and editing them. I usually have it set to lock the controls when adding them, so they don't get 'accidentally' deleted,

The other piece of code simply removes the last character in the content control range. If that last character is a paragraph break ¶ then it removes that break, however you cannot remove the character unless it is in an empty last paragraph and so it is a means to remove an empty last paragraph.

Thanks for the explanation. I already have your CC addin, which is very useful!