VBA: 根据格式替换文本
VBA: Replace text based on formatting
我在 Word 文件 A 中有一个 table，其中包含一堆不同的内容。我只是使用 VBA 将其复制到另一个 Word 或 PowerPoint 文件 B。到目前为止，这不是问题。
但是，由于文件 A 是工作文件 sheet，人们有时会把一些东西划掉，这意味着：它应该被删除，但为了记录在案，它首先留在了那里。在最终版本中它不应该显示，所以在将所有内容复制到不同文件的过程中，应该删除划掉的文本。
将其分解为技术内容：
我想 select Word 文档中的文本，然后删除具有特定格式的所有文本。
也许有一种特殊的 selection 可能性或一种遍历所有字符并测试格式的方法。
在 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 table 复制到另一个 Word 文档和 PowerPoint 演示文稿，以下代码可能会有用。它首先将 table 粘贴到一个新的 Word 文件，然后删除不需要的字符，然后将这个新的 table 粘贴到 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 中迭代字符或段落的性能不受影响的最佳方法是使用查找和替换。
您可以在 vba 中执行此操作，如下所示，注意我已将所有操作包装在自定义撤消记录中，然后您可以使用 CopyDocumentToPowerPoint 调用当前的 vba 例程并word文档将恢复到宏运行之前的状态（划掉的文本保留在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
我在 Word 文件 A 中有一个 table，其中包含一堆不同的内容。我只是使用 VBA 将其复制到另一个 Word 或 PowerPoint 文件 B。到目前为止，这不是问题。
但是，由于文件 A 是工作文件 sheet，人们有时会把一些东西划掉，这意味着：它应该被删除，但为了记录在案，它首先留在了那里。在最终版本中它不应该显示，所以在将所有内容复制到不同文件的过程中，应该删除划掉的文本。
将其分解为技术内容： 我想 select Word 文档中的文本，然后删除具有特定格式的所有文本。
也许有一种特殊的 selection 可能性或一种遍历所有字符并测试格式的方法。
在 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 table 复制到另一个 Word 文档和 PowerPoint 演示文稿，以下代码可能会有用。它首先将 table 粘贴到一个新的 Word 文件，然后删除不需要的字符，然后将这个新的 table 粘贴到 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 中迭代字符或段落的性能不受影响的最佳方法是使用查找和替换。
您可以在 vba 中执行此操作，如下所示，注意我已将所有操作包装在自定义撤消记录中，然后您可以使用 CopyDocumentToPowerPoint 调用当前的 vba 例程并word文档将恢复到宏运行之前的状态（划掉的文本保留在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