删除项目后删除回车

时间:2012-05-10 10:11:27

标签: vba word-vba

我正在从目录中以编程方式删除项目,但回车不会被删除,所以我收到一个带有空格的内容表。 我的代码有一小部分:

For i = cntContentsFields To bngAppendixArray(1) step-1
    selection.Fields(i).Delete
Next

我致力于2007年的单词 这是完整的代码:

On Error GoTo ErrHndl

    Dim i                   As Integer
    Dim iStep               As Integer
    Dim ipos                As Integer
    Dim ipos_2              As Integer
    Dim cntTables           As Integer
    Dim myFontSize          As Integer
    Dim cntWords            As Integer
    Dim cntEnglishWords     As Integer
    Dim cntContentsFields   As Integer
    Dim cntContentsSeif     As Integer
    Dim lneFeedPos          As Integer
    Dim strContents         As String
    Dim bgnAppendixArray()  As Integer
    Dim arrIndex            As Integer

    With ActiveDocument
        If .Range.LanguageID = wdEnglishUS Then
            gDocLang = wdEnglishUS
        Else
            gDocLang = wdHebrew
        End If
    End With

    If ActiveDocument.TablesOfContents.Count >= 1 Then
        ActiveDocument.TablesOfContents(1).Range.Select
        ActiveDocument.TablesOfContents(1).Update
    Else
        Selection.EndKey Unit:=wdLine
        Selection.TypeParagraph
        Selection.Range.Style = ActiveDocument.Styles(wdStyleNormal)
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        myFontSize = Selection.Font.SizeBi + 1

        If gDocLang = wdEnglishUS Then
            Selection.Font.Size = 14
            Selection.TypeText Text:="Index"
        Else
            Selection.TypeText Text:="???? ????????"
        End If

        Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
        Selection.Font.SizeBi = Selection.Font.SizeBi + 2
        Selection.Font.Bold = True
        Selection.Font.BoldBi = True
        Selection.EndKey Unit:=wdLine
        Selection.TypeParagraph
        Selection.Range.Style = ActiveDocument.Styles(wdStyleNormal)
        Selection.TypeParagraph
           With ActiveDocument
            .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
                   True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
                    LowerHeadingLevel:=1, IncludePageNumbers:=True, AddedStyles:="", _
                    UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
                    False
            .TablesOfContents(1).TabLeader = wdTabLeaderSpaces
        End With
    End If

    For cntTables = 1 To ActiveDocument.TablesOfContents.Count
        ActiveDocument.TablesOfContents(cntTables).Range.Select
        Selection.Range.Style = ActiveDocument.Styles("TOC 1")

        If gDocLang = wdEnglishUS Then Selection.LtrPara
    Next

    ActiveDocument.TablesOfContents(1).Range.Select
    cntContentsFields = Selection.Fields.Count
    iStep = 2
    arrIndex = 0
    cntContentsSeif = 0
    strContents = Selection.Fields(1).Result
    lneFeedPos = InStr(1, Selection.Fields(1).Result, Chr(13))
    Do While lneFeedPos > 0
        cntContentsSeif = cntContentsSeif + 1
        strContents = Mid(strContents, lneFeedPos + 1)
        lneFeedPos = InStr(1, strContents, Chr(13))
    Loop

    If cntContentsSeif * 2 <> cntContentsFields - 1 Then GoTo DocumentfromW2000

    For i = 4 To cntContentsFields - 1 Step 2
        iStep = i
        ipos = InStr(1, Selection.Fields(iStep).Result, Chr(46))
        ipos_2 = InStr(1, Selection.Fields(iStep - 2).Result, Chr(46))

        If ipos <= 1 Then
            MsgBox CONTENT_ERR_MSG, vbInformation
            GoTo DocumentfromW2000
        Else
            If Not IsNumeric(Mid(Selection.Fields(iStep).Result, 1, ipos - 1)) Then
                MsgBox CONTENT_ERR_MSG, vbInformation
                GoTo DocumentfromW2000
            End If
        End If

        On Error GoTo DocumentfromW2000


        If CInt(Mid(Selection.Fields(iStep).Result, 1, ipos - 1)) < CInt(Mid(Selection.Fields(iStep - 2).Result, 1, ipos_2 - 1)) Then
            ReDim Preserve bgnAppendixArray(arrIndex)
            bgnAppendixArray(arrIndex) = iStep
            arrIndex = arrIndex + 1
        End If
    Next

     If arrIndex > 1 Then
        For i = cntContentsFields To bgnAppendixArray(1) Step -1
            Selection.Expand wdSentence
            Selection.Fields(i).Delete
        Next
    End If

    If arrIndex > 0 Then
        For i = bgnAppendixArray(0) - 1 To 2 Step -1
        Selection.Expand wdSentence
            Selection.Fields(i).Delete
        Next
    End If
    Exit Sub
DocumentfromW2000:
    Exit Sub
ErrHndl:
    MsgBox "ERROR: " + CStr(Err.Number) + " - " + Err.DESCRIPTION, vbCritical

1 个答案:

答案 0 :(得分:0)

尝试:

Selection.Expand wdSentence

删除之前。