我正在从目录中以编程方式删除项目,但回车不会被删除,所以我收到一个带有空格的内容表。 我的代码有一小部分:
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 :(得分:0)
尝试:
Selection.Expand wdSentence
删除之前。