保留文本的下划线状态以供以后恢复

Question

我正在编写一个模块，该模块应在 1) 将其替换为一些不间断的空格和 2) 将其 Range.Font.Underline 设置为 wdUnderlineSingle 之前存储内容控件 (CC) Range.Text . （以下代码中的Case 2。）

稍后，CC恢复原状。（代码中的Case 3。）

假设原始文本包含下划线和非下划线的混合文本。我如何确保不仅恢复文本值，还恢复其下划线属性的组合？

部分代码如下：

' Code before omitted
          For Each oCC In oRngStory.ContentControls
            Select Case lngAction
              Case 1
                oCount = oCount + 1
              Case 2
                oCount = oCount + 1
                ' CC inside body text: replace text value with 30 nonbreaking spaces
                If LCase(oCC.Tag) = "body text" Then
                    ' Store existing text
                    arrText(i) = oCC.Range.Text
                    ' Temporarily replace text with 30 nonbreaking spaces
                    oCC.Range.Text = String(30, ChrW(160))
                    ' Underline text
                    oCC.Range.Font.Underline = wdUnderlineSingle
                End If
                i = i + 1
              Case 3
                oCount = oCount + 1
                If LCase(oCC.Tag) = "body text" Then
                    ' Restore existing text
                    oCC.Range.Text = arrText(i)
                    ' ### HOW TO RESTORE EXISTING TEXT'S UNDERLINE STATE?
                End If
                i = i + 1
            End Select
          Next oCC
' Code after omitted

Answer 1

您不能在文本变量中存储格式。相反，您可以 hide/unhide 文本，使用以下内容：

Dim oCC As ContentControl, oRngStory As Range, Rng As Range
Dim lngAction As Long, oCount As Long
...
          For Each oCC In oRngStory.ContentControls
            oCount = oCount + 1
            With oCC
              If LCase(.Tag) = "body text" Then
                Select Case lngAction
                Case 2
                  ' Replace text value with 30 nonbreaking spaces
                  Set Rng = .Range
                    With Rng
                      ' Temporarily replace visible text with 30 nonbreaking spaces
                      .InsertBefore String(30, ChrW(160))
                      .Start = .Start + 30
                      .Font.Hidden = True
                      ' Underline text
                      .Collapse wdCollapseStart
                      .Start = .Start - 30
                      .Font.Underline = wdUnderlineSingle
                    End With
                    i = i + 1
                Case 3
                  ' Restore original text
                  Set Rng = .Range
                  With Rng
                    .End = .Start + 30
                    .Text = vbNullString
                  End With
                  .Range.Font.Hidden = False
                End Select
              End If
            End With
          Next oCC

当然，如果下划线是唯一的特殊字体属性，并且它适用于内容控件的所有内容，您可以只在整个内容控件下划线，这样就不需要下划线代码了：

  For Each oCC In oRngStory.ContentControls
    oCount = oCount + 1
    With oCC
      If LCase(.Tag) = "body text" Then
        Select Case lngAction
          Case 2
            arrText(i) = oCC.Range.Text
            ' Temporarily replace text with 30 nonbreaking spaces
            .Range.Text = String(30, ChrW(160))
          Case 3
            oCC.Range.Text = arrText(i)
        End Select
        i = i + 1
      End If
    End With
  Next oCC

Answer 2

另一种方法是使用自定义撤消记录。例如：

Dim objUndo As UndoRecord
Set objUndo = Application.UndoRecord
With objUndo
  If .IsRecordingCustomRecord = False Then
  .StartCustomRecord ("Demo")
    For Each oCC In oRngStory.ContentControls
    With oCC
      If LCase(.Tag) = "body text" Then
        ' Temporarily replace text with 30 nonbreaking spaces
        .Range.Text = String(30, ChrW(160))
      End If
    End With
  Next oCC
  'insert whatever further processing you want to perform here
  .EndCustomRecord
End With
ActiveDocument.Undo

使用这种方法，您的临时更改会在完成后自动撤消。

保留文本的下划线状态以供以后恢复

Preserve underline status of text for later restoration

vba

ms-word