2012-05-10 4 views
2

Я удаляю программные элементы из Таблицы содержимого, но возврат каретки не удаляется, поэтому я получаю таблицу содержимого с пробелами. Существует надрез моего кода:удалить возврат каретки после удаления элементов

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 

ответ

0

Try:

Selection.Expand wdSentence 

Перед удалением.

+0

возврат каретки не удаляется, и у меня есть пробелы между элементами, которые я удалил. Любые другие идеи? – Kerenlu

+0

Нет, не без кода и примечания о том, какая версия Word. – Fionnuala

+0

Я работаю над словом 2007 – Kerenlu

Смежные вопросы