使用 VBA 将旧控件转换为内容控件 [In Word] 有时不起作用

Question

由于旧表格在我的公司造成了问题，我需要将所有信件切换为使用新的内容控件。 每个表单上约有 120 个字母，平均有 20 个控件，因此手动完成的工作量很大。我进行了搜索，发现可以自动执行此操作：Convert Legacy Controls to Content Controls

我已经采取了该代码并通过清理它并添加一些更多功能对其进行了一些修改：

    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

代码在 60% 的时间内有效。 40% 的时间它不起作用，我得到一个对象不支持此操作（错误 445）。 它们也是同一类型的控件吗？ 我看不出有什么区别。 我一直在尝试查看是否有不同的属性，但我看不到任何不同的地方。 我想说的是，目前它只发生在文本字段上。 我尝试添加 wdContentControlText 和 wdContentControlRichText。 有人经历过这个问题吗？ 有什么想法吗？ 我已经查看过，但找不到其他人遇到此问题。

那个

    FieldRng.End = 560
    FieldRng.Select

在代码中我尝试选择范围或修改其大小。 我认为没有必要。另外，

Set CC = ActiveDocument.ContentControls.Add(wdContentControlText)

原本是

 Set CC = ActiveDocument.ContentControls.Add(wdContentControlText, Fieldrng)

。 我只是在没有 Fieldrng 的情况下进行测试。

Answer 1

尝试以下方法 - 它有点复杂。

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