Question

我在Word文件A中有一个表，其中包含许多不同的内容。我只是使用VBA复制到另一个Word或PowerPoint文件B.到目前为止，这不是一个问题。

然而，由于文件A是一张工作表，人们有时会把东西交叉，这意味着：它应该被移除，但是为了记录它首先留在那里。在最终版本中它不应该显示，因此在复制不同文件中的所有内容的过程中，应删除划掉的文本。

将其分解为技术内容：我想在Word文档中选择文本，然后删除具有特定格式的所有文本。

也许有一种特殊的选择可能性或迭代所有字符并测试格式化的方法。

Answer 1

在vba中使用严重的性能迭代字符或段落的最佳方法是使用查找和替换。

您可以在vba中执行以下操作，请注意我已将所有操作包装在自定义撤消记录中，然后您可以使用CopyDocumentToPowerPoint调用当前的vba例程，并将word文档恢复为状态在宏运行之前（划掉的文本仍然在单词中，但未粘贴到powerpoint上）。

'wrap everything you do in an undo record
Application.UndoRecord.StartCustomRecord "Move to powerpoint"

With ActiveDocument.Range.Find
    .ClearFormatting
    .Font.StrikeThrough = True
    .Text = ""
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
End With

'copy to powerpoint and whatever else you want
CopyDocumentToPowerPoint

Application.UndoRecord.EndCustomRecord

'and put the document back to where you started
ActiveDocument.Undo

Answer 2

可以逐个字符地删除那些在其上启用了删除线字体的字符（划掉的字符）在MS Word 中。但是，据我所知，在MS PowerPoint中没有检测到删除字体的可能性。

如果您只需要删除仅在所选文本中具有删除线字体的文本，则可以使用此Word宏：

Sub RemoveStrikethroughFromSelection()
    Dim char As Range
    For Each char In Selection.Characters
        If char.Font.StrikeThrough = -1 Then
            char.Delete
        End If
    Next
End Sub

如果将Word表格更多地集成到另一个Word文档和PowerPoint演示文稿中，则以下代码可能会有用。它首先将表粘贴到新的Word文件，然后删除不必要的字符，然后将此新表粘贴到PowerPoint。

Sub CopyWithoutCrossedOutText()
    Dim DocApp As Object: Set DocApp = CreateObject("Word.Application")
    Dim PptApp As Object: Set PptApp = CreateObject("PowerPoint.Application")
    Dim Doc As Object: Set Doc = DocApp.Documents.Add
    Dim Ppt As Object: Set Ppt = PptApp.Presentations.Add
    Dim c As Cell
    Dim char As Range
    DocApp.Visible = True
    PptApp.Visible = True

    'Copying Word table to the 2nd Word document
    ThisDocument.Tables(1).Range.Copy
    Doc.ActiveWindow.Selection.Paste

    'In the 2nd Word document - removing characters having strikethrough font enabled on them
    For Each c In Doc.Tables(Doc.Tables.Count).Range.Cells
        For Each char In c.Range.Characters
            If char.Font.StrikeThrough = -1 Then
                char.Delete
            End If
        Next
    Next

    'Copying the table from the 2nd Word document to the PowerPoint presentation
    Doc.Tables(1).Range.Copy
    Ppt.Slides.Add(1, 32).Shapes.Paste

End Sub

VBA：根据格式替换文本

2 个答案: