删除除起点和终点之间的单词之外的所有内容

时间:2016-01-26 11:04:35

标签: vba ms-word word-vba

我碰巧尝试按照自己的喜好操纵下面的代码。 首先,下面的代码删除了我在程序中规定的开始和结束条件之间的所有内容。

我想改变这一点,删除除开始和结束词之间规定的所有内容。

Sub SomeSub()
    Dim StartWord As String, EndWord As String
    Dim Find1stRange As Range, FindEndRange As Range
    Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Setting up the Ranges
    Set Find1stRange = ActiveDocument.Range
    Set FindEndRange = ActiveDocument.Range
    Set DelRange = ActiveDocument.Range

    'Set your Start and End Find words here to cleanup the script
    StartWord = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
    EndWord = "This message has been scanned for malware by Websense. www.websense.com"

    'Starting the Find First Word
    With Find1stRange.Find
        .Text = StartWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        'Execute the Find
        Do While .Execute
            'If Found then do extra script
            If .Found = True Then
                'Setting the Found range to the DelStartRange
                Set DelStartRange = Find1stRange
                'Having these Selections during testing is benificial to test your script
                DelStartRange.Select

                'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
                FindEndRange.Start = DelStartRange.End
                FindEndRange.End = ActiveDocument.Content.End

                'Having these Selections during testing is benificial to test your script
                FindEndRange.Select

                'Setting the Find to look for the End Word
                With FindEndRange.Find
                    .Text = EndWord
                    .Execute

                    'If Found then do extra script
                    If .Found = True Then
                        'Setting the Found range to the DelEndRange
                        Set DelEndRange = FindEndRange

                        'Having these Selections during testing is benificial to test your script
                        DelEndRange.Select

                    End If
                End With

                'Selecting the delete range
                DelRange.Start = DelStartRange.Start
                DelRange.End = DelEndRange.End
                'Having these Selections during testing is benificial to test your script
                DelRange.Select

                'Remove comment to actually delete
                DelRange.Delete
            End If      'Ending the If Find1stRange .Found = True
        Loop        'Ending the Do While .Execute Loop 
    End With    'Ending the Find1stRange.Find With Statement
End Sub

2 个答案:

答案 0 :(得分:1)

哈!这是一个新的转折当然不止一种方式;我倾向于与(至少)三个范围合作。像这样:

Sub FindAndDeleteEverythingElse()
  Dim strFind1 As String, strFind2 As String
  Dim rngDoc As word.Range, rngFind1 As word.Range
  Dim rngFind2 As word.Range
  Dim bFound As Boolean

  strFind1 = "You"
  strFind2 = "directly."
  Set rngDoc = ActiveDocument.content
  Set rngFind1 = rngDoc.Duplicate
  Set rngFind2 = rngDoc.Duplicate
  With rngFind1.Find
    .Text = strFind1
    bFound = .Execute
  End With
  If bFound Then
    With rngFind2.Find
        .Text = strFind2
        bFound = .Execute
    End With
    If bFound Then
        rngDoc.End = rngFind1.Start
        rngDoc.Delete
        rngDoc.Start = rngFind2.End
        rngDoc.End = ActiveDocument.content.End
        rngDoc.Delete
    End If
  End If
End Sub

“main”范围是整个文档的范围:ActiveDocument.Content。 Range对象与其他对象略有不同,如果将一个Range设置为另一个,则它变为Range,而不是副本。因此,您需要Duplicate方法来制作Range的副本。这使您可以单独使用Find来表示各种范围。

如果第一个查找成功,则执行第二个查找。如果这也成功,则将文档范围的终点设置为成功查找的起始点,并删除范围的内容。然后重新定义文档范围,从第二个找到的范围的终点开始,到文档末尾结束,并删除。

您可能需要设置比我在此代码段中更多的Range.Find属性 - 我使用绝对最小值来更好地使用Ranges。

答案 1 :(得分:0)

可能有另一种方式,但在此之前你可以做到这一点。 尝试在字符串之前和之后添加虚拟字符,如此

With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = False
      .Text = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
      .Replacement.Text = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |######"
      .Execute Replace:=wdReplaceAll
      .Text = "This message has been scanned for malware by Websense. www.websense.com"
      .Replacement.Text = "@@@@@@This message has been scanned for malware by Websense. www.websense.com"
      .Execute Replace:=wdReplaceAll
    End With
End With
End Sub

然后尝试在######和@@@@@@

之间设置范围

这是设定范围select a range of text from one Word document and copy into another Word document

的最佳答案

请注意,在我的单词2007中,无法在超链接中找到。在替换之前尝试删除所有超链接或范围内。 另一个最佳答案:How do you remove hyperlinks from a Microsoft Word document?