Because of an issue that the old forms are causing in my company, I need to switch all our letters over to using the new content controls. There are ~120 letters with an average of 20 controls on every form, so it would be a lot of work to do manually. I did a search and found this to do it automatically: Convert Legacy Controls to Content Controls
I have taken that code and modified it some by cleaning it up and adding some more functionality:
Sub ConvertLegacyControlsToContentControls()
Dim FF As FormField
Dim CC As ContentControl
Dim DefaultText, FieldName As String
Dim NumOfFields As Long, ComboEntryNum, FieldFontSize, FieldType As Long
Dim CheckValue As Boolean
Dim ComboBoxValuess() As String
Dim FieldRng As Range
Dim doc As Document: Set doc = ActiveDocument
For NumOfFields = doc.FormFields.Count To 1 Step -1
Set FF = doc.FormFields(NumOfFields)
Set FieldRng = FF.Range
FieldFontSize = FieldRng.Font.Size
FieldType = FF.Type
If FieldType = 83 Or FieldType = 70 Then
DefaultText = FF.Result
FieldName = FF.Name
End If
Select Case FieldType
Case 83 'Comboboxes
ReDim ComboBoxValuess(1 To FF.DropDown.ListEntries.Count)
For ComboEntryNum = 1 To FF.DropDown.ListEntries.Count
ComboBoxValuess(ComboEntryNum) = FF.DropDown.ListEntries(ComboEntryNum).Name
Next ComboEntryNum
FF.Delete
Set CC = doc.ContentControls.Add(wdContentControlDropdownList, FieldRng)
CC.DropdownListEntries.Add CC.PlaceholderText, vbNullString
For ComboEntryNum = 1 To UBound(ComboBoxValuess)
CC.DropdownListEntries.Add ComboBoxValuess(ComboEntryNum), ComboBoxValuess(ComboEntryNum)
If CC.DropdownListEntries(CC.DropdownListEntries.Count).Value = DefaultText Then
CC.DropdownListEntries(CC.DropdownListEntries.Count).Select
End If
Next ComboEntryNum
Case 71 ' Check Boxes
CheckValue = FF.CheckBox.Value
FF.Delete
Set CC = doc.ContentControls.Add(wdContentControlCheckBox, FieldRng)
CC.Checked = CheckValue
Case 70 'Text Fields
FF.Delete
FieldRng.End = 560
FieldRng.Select
Set CC = ActiveDocument.ContentControls.Add(wdContentControlText)
End Select
If FieldType = 83 Or FieldType = 70 Then
With CC
.Range.Text = DefaultText
.Range.Font.Size = FieldFontSize
.Title = FieldName
End With
End If
Next NumOfFields
End Sub
The code works 60% of the time. The 40% of the time it doesn’t work, I get a Object doesn’t support this action (Error 445). They are the same type of controls also? I do not see a difference. I have been trying to see if there was a property that was different but I cannot see anything that is different. I will say that currently it is only happening on Text Fields. I have tried to add both wdContentControlText and wdContentControlRichText. Has anyone experienced this issue? have any ideas? I have looked and cannot find anyone else having this issue.
The
FieldRng.End = 560
FieldRng.Select
in the code was me trying to select the range or modify its size. I don’t think it is necessary. Also Set CC = ActiveDocument.ContentControls.Add(wdContentControlText) was originally Set CC = ActiveDocument.ContentControls.Add(wdContentControlText, Fieldrng). I was just testing without the Fieldrng also.
3
Try the following – it’s a bit more sophisticated.
Sub ConvertLegacyControlsToContentControls()
Application.ScreenUpdating = False
Dim FmFld As FormField, CCtrl As ContentControl, FldRng As Range
Dim StrDef As String, StrRslt As String, FldNm As String, StrFntNm As String
Dim i As Long, j As Long, SngFntSz As Single, FldFmt As Long, StrFmt As String
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
Set FmFld = .FormFields(i)
With FmFld
StrDef = .TextInput.Default
StrFmt = .TextInput.Format
StrRslt = .Result
FldNm = .Name
FldFmt = .TextInput.Type
SngFntSz = .Range.Font.Size
StrFntNm = .Range.Font.Name
Set FldRng = .Range: FldRng.Collapse wdCollapseStart
End With
Set CCtrl = .ContentControls.Add(Type:=wdContentControlText, Range:=FldRng)
With CCtrl
.Title = FldNm
If StrDef <> StrRslt Then .Range.Text = StrRslt
.Range.Font.Size = SngFntSz
.Range.Font.Name = StrFntNm
End With
Select Case FmFld.Type
Case wdFieldFormTextInput
If StrDef <> "" Then CCtrl.SetPlaceholderText Text:=StrDef
If FldFmt = 2 Then
If StrDef = StrRslt Then CCtrl.Range.Text = ""
CCtrl.Type = wdContentControlDate
CCtrl.DateDisplayFormat = StrFmt
End If
Case wdFieldFormDropDown
With CCtrl
.Type = wdContentControlDropdownList
For j = 1 To FmFld.DropDown.ListEntries.Count
.DropdownListEntries.Add Text:=FmFld.DropDown.ListEntries(j).Name
Next
.SetPlaceholderText Text:=.DropdownListEntries(1)
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDropdownList
End With
Case wdFieldFormCheckBox
CCtrl.Type = wdContentControlCheckBox
CCtrl.Checked = FmFld.CheckBox.Value
End Select
FmFld.Delete
Next
End With
Application.ScreenUpdating = True
End Sub