View Single Post
 
Old 11-02-2022, 09:31 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,138
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote