Question

我正在尝试通过宏从Word文本中删除突出显示的空白字符，但是只要遇到一些注释或URL（不是全部），它就会挂起/循环。这怎么可能？那么解决方案是什么？

Sub checkforHighlightsOrg()

    Application.ScreenUpdating = False
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "^\s+$" ' highlighted text having multiple white-space/invisible chars only
    
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    With Selection.Find
        .text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
        .Replacement.Highlight = True
        .Replacement.ClearFormatting
    End With
    
    Dim bReplaced As Boolean
    bReplaced = False
    
    Do While Selection.Find.Execute = True
        If Selection.Find.Found Then
             If regex.Test(Selection.text) Then
                bReplaced = True
                Selection.text = regex.Replace(Selection.text, "")
             End If
        End If
        DoEvents
    Loop
    
    If bReplaced Then MsgBox "Highlighted white-spaces have been removed."
    
    Set rngTemp = ActiveDocument.Range

    With rngTemp.Find
        .ClearFormatting
        .Highlight = True
        .Forward = True
        .Execute
    End With
    If rngTemp.Find.Found = True Then
        MsgBox ("There have been non-white-space highlights found.")
    End If
    
    Application.ScreenUpdating = True

End Sub

我尝试过的另一个版本如下：

Sub checkforHighlightsV2()

    Application.ScreenUpdating = False
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "\s+" ' highlighted text having multiple white-space/invisible chars only
    ActiveDocument.Select
      
    
    Dim regex2 As Object, str As String
    Set regex2 = CreateObject("VBScript.RegExp")
     
    With regex2
      .Pattern = "\s"
      .Global = True 'If False, would replace only first
    End With

    
    
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    With Selection.Find
        .text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
        .Replacement.Highlight = True
        .Replacement.ClearFormatting
    End With
    
    Dim bReplaced As Boolean
    bReplaced = False
    Dim a As Range

    
    
    
restart:
    
    Do While Selection.Find.Execute = True
        If Selection.Find.Found Then
    'Selection.MoveEnd wdParagraph, 1
    
     
    Set a = Selection.Range.Duplicate
    'Debug.Print Asc(a.text)
    
    'a.MoveEnd wdCharacter, -1
    
    Dim res As String
     
    If regex.Replace(Replace(a.text, Chr(160), ""), "") = "" Then
    Debug.Print "empty"
    Selection.Delete
    End If
     
'    If a.text = vbCr Or a.text = vbLf Or a.text = vbCrLf Or a.text = vbNewLine Or a.text = vbTab Then
'   ' Debug.Print "newline"
'       bReplaced = True
'                Selection.Delete
'                GoTo restart
'
'    End If
'    If a.text = " " Then Selection.Delete
'
''
''             If regex.Test(a.text) Then
''                bReplaced = True
''                'a.text = regex.Replace(a.text, "")
''                Selection.Delete
''
''             End If
        End If
        DoEvents
    Loop
    
    If bReplaced Then MsgBox "Highlighted white-spaces have been removed."
    
    Set rngTemp = ActiveDocument.Range

    With rngTemp.Find
        .ClearFormatting
        .Highlight = True
        .Forward = True
        .Execute
    End With
    If rngTemp.Find.Found = True Then
        MsgBox ("There have been non-white-space highlights found, this usually means default text.")
    End If
    
    Application.ScreenUpdating = True

End Sub

起初我以为我不应该在激活搜索选择时替换文本，所以我尝试通过创建版本2并调用selection.delete来修复它，但是以某种方式也行不通。

普通的搜索对话框永远不会循环，但是那里不允许有空格字符。谢谢您的帮助。

编辑：我也尝试过此操作（仅删除突出显示；不删除空格，当我按下Enter键插入文本时也突出显示了换行符/新段落时，也是如此-这表明标记/突出显示在换行符/段落char上处于活动状态-我尝试了一些类似^ w ^ p的变体，但是当我想使用OR运算符时，无法将其与“使用通配符”选项结合使用

Sub Macro6()
'
' Macro6 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = False
    With Selection.Find
        .Text = "^w"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

最新版本：

Sub RemoveHighlightedWhiteSpace()
   Application.ScreenUpdating = False
   With ActiveDocument.Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .Replacement.Highlight = False
      .text = "[ ,^9,^11,^12,^13," & Chr(160) & "," & Chr(164) & "]{2,}"
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
   End With
   Application.ScreenUpdating = True
End Sub

Answer 1

尝试下面的代码。我找不到包含的唯一字符是vbLf。

要删除突出显示，您需要使用begin routers smarthost: debug_print = "R: smarthost for $local_part@$domain" driver = manualroute headers_add = X-SES-CONFIGURATION-SET: CloudWatch headers_add = X-SES-MESSAGE-TAGS: customer=senet, application=twentyfour domains = ! +local_domains transport = remote_smtp_smarthost route_list = * email-smtp.eu-central-1.amazonaws.com:587 byname host_find_failed = ignore same_domain_copy_routing = yes no_more COND_LOCAL_SUBMITTER = "${if match_ip{$sender_host_address}{:@[]}{1}{0}}"，但这不会删除字符，因此必须单独运行。

Format = True

编辑：您要实现的目标仍不清楚。从您的评论看来，您似乎正在尝试从整个文档中删除所有突出显示的内容。如果是这样，那么有一种简单的方法可以做到这一点：

Sub DeleteHighlightedWhiteSpace()
   'finds at least any 2 of vbTab, vbVerticalTab, vbFormFeed, vbCr, non-breaking space
   Application.ScreenUpdating = False
   With ActiveDocument.Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .text = "[ ,^9,^11,^12,^13," & Chr(160) & "]{2,}"
      .Replacement.text = ""
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
   End With
   Application.ScreenUpdating = True
End Sub

Sub RemoveHighlighting()
   Application.ScreenUpdating = False
   With ActiveDocument.Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .Replacement.Highlight = False
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .Execute Replace:=wdReplaceAll
   End With
   Application.ScreenUpdating = True
End Sub

删除突出显示的空白

1 个答案: