Create additional CCs based on Combo Box selection

CellCharger · #1 11-01-2022, 08:59 PM

Hi everyone,

I am not knowledgeable in VBA. I have a protected form with multiple Content Controls. One of which is a Combo Box.
Based on the Combo Box selection "C", I want the form to create two fields (Rich Text CC and Combo Box (with 3 selections: ACC, Ambient and Long-term), plus a text representing the fields' title).

To provide a visual, the form looks like the image to the left.

There are 3 empty cells where I need the additional CCs to be created in the area circled in red.
Once the user selects C from the "Protocol Type" Combo Box, 2 additional CC will be created. So basically, the form would look like the image to the right.

Something else I need to mention is that there is an existing macro in the form.

I tried to be as clear and descriptive as possible but please let me know if need to clarify anything else. I also attached the form.

gmayor · #2 11-01-2022, 10:31 PM

There is no macro in your document. DOCX does not support macros.
The following will do what you ask. Put the code in the ThisDocument module of the document and save as macro enabled.

Code:

Option Explicit

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim oTable As Table
Dim oCC As ContentControl
Dim oRng As Range
Dim i As Integer
    Set oTable = ActiveDocument.Tables(1)
    If ContentControl.Title = "Protocol Type" Then
        If Not ActiveDocument.ProtectionType = wdNoProtection Then
            ActiveDocument.Unprotect
        End If
        If ContentControl.Range.Text = "D" Then
            Set oRng = oTable.Range.Cells(38).Range
            oRng.End = oRng.End - 1
            oRng.Text = "Stability timepoint"

            Set oRng = oTable.Range.Cells(39).Range
            oRng.End = oRng.End - 1
            Set oCC = oRng.ContentControls.Add(wdContentControlText)
            With oCC
                .Title = "Timepoint"
                .Tag = "Timepoint"
                .SetPlaceholderText , , "Timepoint"
                .Range.Editors.Add (wdEditorEveryone)
            End With

            Set oRng = oTable.Range.Cells(40).Range
            oRng.End = oRng.End - 1
            Set oCC = oRng.ContentControls.Add(wdContentControlDropdownList)
            With oCC
                .Title = "Temperature"
                .Tag = "Temperature"
                .SetPlaceholderText , , "Select Temperature"
                .DropdownListEntries.Add .PlaceholderText, ""
                .DropdownListEntries.Add "ACC", "ACC"
                .DropdownListEntries.Add "Long Term", "Long Term"
                .DropdownListEntries.Add "Ambient", "Ambient"
                .Range.Editors.Add (wdEditorEveryone)
            End With
        Else
            For i = 38 To 40
                Set oRng = oTable.Range.Cells(i).Range
                oRng.End = oRng.End - 1
                oRng.Text = ""
            Next i
        End If
        ContentControl.Range.Editors.Add (wdEditorEveryone)
        ActiveDocument.Protect (wdAllowOnlyReading)
    End If
lbl_Exit:
    Set oCC = Nothing
    Set oRng = Nothing
    Set oTable = Nothing
    Exit Sub
End Sub

CellCharger · #3 11-02-2022, 06:10 AM

Thank you Graham for your response.

This is the existing macro. It adds 30 days in the due date field . I am not sure but it looks it it disappeared when I saved the file as DOCX.

Code:

Option Explicit

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Dt As Date, StrDt As String
With CCtrl
  If .Title <> "Date of Initiation" Then Exit Sub
  If .ShowingPlaceholderText = True Then
    ActiveDocument.SelectContentControlsByTitle("Due Date")(1).Range.Text = ""
  Else
    StrDt = .Range.Text
    If IsDate(StrDt) Then
      Dt = CDate(StrDt)
    Else
      Dt = CDate(Split(StrDt, (Split(StrDt, " ")(0)))(1))
    End If
    ActiveDocument.SelectContentControlsByTitle("Due Date")(1).Range.Text = Format(Dt + 30, .DateDisplayFormat)
  End If
End With
Application.ScreenUpdating = True
End Sub

I also uploaded a macro enabled test form in the original post.

gmayor · #4 11-02-2022, 09:31 PM

As I said earlier, DOCX format does not support macros.
It is simple enough to combine the macros.

Code:

Option Explicit

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
    Application.ScreenUpdating = False
    Dim Dt As Date, StrDt As String
    Dim oTable As Table
    Dim oCC As ContentControl
    Dim oRng As Range
    Dim i As Integer
    Set oTable = ActiveDocument.Tables(1)
    Select Case CCtrl.Title
        Case "Protocol Type"
            If Not ActiveDocument.ProtectionType = wdNoProtection Then
                ActiveDocument.Unprotect
            End If
            If CCtrl.Range.Text = "D" Then
                Set oRng = oTable.Range.Cells(38).Range
                oRng.End = oRng.End - 1
                oRng.Text = "Stability timepoint"

                Set oRng = oTable.Range.Cells(39).Range
                oRng.End = oRng.End - 1
                Set oCC = oRng.ContentControls.Add(wdContentControlText)
                With oCC
                    .Title = "Timepoint"
                    .Tag = "Timepoint"
                    .SetPlaceholderText , , "Timepoint"
                    .Range.Editors.Add (wdEditorEveryone)
                End With

                Set oRng = oTable.Range.Cells(40).Range
                oRng.End = oRng.End - 1
                Set oCC = oRng.ContentControls.Add(wdContentControlDropdownList)
                With oCC
                    .Title = "Temperature"
                    .Tag = "Temperature"
                    .SetPlaceholderText , , "Select Temperature"
                    .DropdownListEntries.Add .PlaceholderText, ""
                    .DropdownListEntries.Add "ACC", "ACC"
                    .DropdownListEntries.Add "Long Term", "Long Term"
                    .DropdownListEntries.Add "Ambient", "Ambient"
                    .Range.Editors.Add (wdEditorEveryone)
                End With
            Else
                For i = 38 To 40
                    Set oRng = oTable.Range.Cells(i).Range
                    oRng.End = oRng.End - 1
                    oRng.Text = ""
                Next i
            End If
            CCtrl.Range.Editors.Add (wdEditorEveryone)
            ActiveDocument.Protect (wdAllowOnlyReading)
        Case "Date of Initiation"
            With CCtrl
                If .ShowingPlaceholderText = True Then
                    ActiveDocument.SelectContentControlsByTitle("Due Date")(1).Range.Text = ""
                Else
                    StrDt = .Range.Text
                    If IsDate(StrDt) Then
                        Dt = CDate(StrDt)
                    Else
                        Dt = CDate(Split(StrDt, (Split(StrDt, " ")(0)))(1))
                    End If
                    ActiveDocument.SelectContentControlsByTitle("Due Date")(1).Range.Text = Format(Dt + 30, .DateDisplayFormat)
                End If
            End With
        Case Else
    End Select
lbl_Exit:
    Application.ScreenUpdating = True
    Set oCC = Nothing
    Set oRng = Nothing
    Set oTable = Nothing
    Exit Sub
End Sub

CellCharger · #5 11-03-2022, 06:29 AM

Thank you so much Graham. It works great.

I appreciate your help!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Text based on selection of dropdown list	cloud67	Word VBA	2	08-09-2019 06:46 AM
Reveal portion of document based on dropdown selection	chappeja	Word VBA	1	03-27-2019 08:36 PM
Mail Merge Using Rules "IF" to add additional Text Based On Merge Field Content	Alfred	Mail Merge	2	05-23-2017 10:59 PM
text based on Combo box selection	rosscortb	Word VBA	3	03-16-2015 06:57 PM
Inserting a particular image based on a combobox selection	LeonieD	PowerPoint	2	06-27-2014 05:39 PM