问题描述
- 请哪位大神知道如何用VBA代码做word索引，求代码啊。。拜托拜托。。
- 请哪位大神知道如何用VBA（visual basic）代码做word索引，求代码啊。。拜托拜托。。
解决方案
我也来个：需要你手动提供关键词哦....
Sub Test()
BiaoJiAll ""编辑|学校"" ''
End Sub
Sub BiaoJiAll(ByVal bStr As String)
''bStr为关键词，用|分割
On Error Resume Next
Dim i As Long w1 As String ww
ww = Split(bStr|"")
If UBound(ww) >= 0 Then
For i = 0 To UBound(ww)
Selection.HomeKey Unit:=wdStory ''移动到开始
With Selection.Find
.ClearFormatting
.Text = ww(i)
.Execute
If .Found Then ''如果找到了则添加到索引
ActiveDocument.Indexes.MarkAllEntries Range:=Selection.Range Entry:= _
ww(i) EntryAutoText:=ww(i) CrossReference:="""" CrossReferenceAutoText _
:="""" BookmarkName:="""" Bold:=False Italic:=False
End If
End With
Next
''定位到最后
Selection.EndKey Unit:=wdStory
''在文档最后插入索引
ThisDocument.Indexes.Add Range:=Selection.Range HeadingSeparator:= _
wdHeadingSeparatorNone Type:=wdIndexIndent RightAlignPageNumbers:= _
True NumberOfColumns:=2 SortBy:=wdIndexSortByStroke IndexLanguage _
:=wdSimplifiedChinese
End If
End Sub
解决方案二：
Dim colWords as CollectionSet colWords = New Colection'add words you don't want to indexcolWords.Add ""and""colWords.Add ""you""Dim wrd As RangeFor Each wrd In ActiveDocument.Words 'only if we have 3 chars we index If Len(Trim(wrd.Text)) > 2 Then ' prevent the field from being Indexed as well... Dim infield As Boolean infield = False Dim fld As Field For Each fld In ActiveDocument.Fields If (wrd.Start >= fld.Code.Start And wrd.End <= fld.Code.End) Then infield = True Exit For 'break out End If Next If (Not infield) Then ' check if we already indexed? Dim findWord as String findWord = LCASE(wrd.Text) For Each cached in colWords if cached = findWord Then infield = True Exit For 'break out end If Next If (Not infield) Then ActiveDocument.Indexes.MarkAllEntries Range:=wrd Entry:=wrd.Text _ EntryAutoText:=wrd.Text CrossReference:="""" CrossReferenceAutoText:="""" _ BookmarkName:="""" Bold:=False Italic:=False colWords.Add findWord End If End If End IfNext解决方案三：
总有一款适合你
Sub CreateIndex() ' ' CreateIndex Macro With ActiveDocument.PageSetup .LineNumbering.Active = False .Orientation = wdOrientPortrait .TopMargin = InchesToPoints(0.8) .BottomMargin = InchesToPoints(0.8) .LeftMargin = InchesToPoints(0.8) .RightMargin = InchesToPoints(0.8) .Gutter = InchesToPoints(0) .HeaderDistance = InchesToPoints(0.5) .FooterDistance = InchesToPoints(0.5) .PageWidth = InchesToPoints(8.5) .PageHeight = InchesToPoints(11) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBin .SectionStart = wdSectionNewPage .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .VerticalAlignment = wdAlignVerticalTop .SuppressEndnotes = False .MirrorMargins = False .TwoPagesOnOne = False .GutterPos = wdGutterPosLeft End With Selection.Sections(1).Headers(1).pageNumbers.Add PageNumberAlignment:= _ wdAlignPageNumberRight FirstPage:=True Dim quote As String Dim Keyword As String Dim j As Integer quote = """""""" Dim found_key As Boolean Dim startSearch As Long Dim endSearch As Long Close #1 Open ""c:boss_info_index.txt"" For Input As #1 Set myRange = ActiveDocument.Content j = 0 Do While Not EOF(1) ' Loop until end of file. Set myRange = ActiveDocument.Content endSearch = myRange.End Input #1 Keyword j = 0 With myRange.Find .Text = Keyword .Forward = True .MatchWholeWord = True .MatchCase = False End With While myRange.Find.Execute myRange.Collapse wdCollapseEnd Set myIndexEntry = myRange.Fields.Add(myRange Type:=wdFieldIndexEntry _ Text:=quote & Keyword & quote) startSearch = myRange.End startSearch = startSearch + 7 Set myRange = ActiveDocument.Content myRange.Start = startSearch If startSearch endSearch - 1 Then GoTo skip_while End If With myRange.Find .Text = Keyword .Forward = True .MatchWholeWord = True .MatchCase = False End With ' this code is because I had a loop here j = j + 1 If j 300 Then myRange.Bold = True Exit Do End If Wend skip_while: Loop Close #1 ' Close file. myRange.Start = 0 myRange.End = 0 With ActiveDocument .Indexes.Add Range:=myRange HeadingSeparator:= _ wdHeadingSeparatorNone Type:=wdIndexIndent RightAlignPageNumbers:= _ True NumberOfColumns:=1 IndexLanguage:=wdEnglishUS .Indexes(1).TabLeader = wdTabLeaderDots End With End Sub解决方案四：
Sub DemoIndex() Dim Tbl As Table Dim r As Range With ActiveDocument ' for each table For Each Tbl In .Tables ' set range for paragraph before the table Set r = Tbl.Range.Characters.First.Previous.Paragraphs.First.Range ' use text that pparagraph for Index entry .Indexes.MarkEntry Range:=r _ Entry:=r.Text _ EntryAutoText:=r.Text _ CrossReference:="""" CrossReferenceAutoText:="""" _ BookmarkName:="""" Bold:=False Italic:=False Reading:="""" Set r = Nothing ' go to next table Next ' go to end of document and make a new section ' put in text for a title/heading With Selection .EndKey Unit:=wdStory .InsertBreak Type:=wdSectionBreakNextPage .TypeText ""Table List"" & vbCrLf & vbCrLf End With ' create Index listing .Indexes.Add Range:=Selection.Range HeadingSeparator:= _ wdHeadingSeparatorNone Type:=wdIndexIndent RightAlignPageNumbers:= _ False NumberOfColumns:=2 IndexLanguage:=wdEnglishCanadian .Indexes(1).TabLeader = wdTabLeaderDots End With End Sub解决方案五：
最简单的方法，录制宏，然后手工操作，然后查看宏就可以了
解决方案六：
用于MS Word文档的所有词语索引
解决方案七：
我是word2003的，这代码在我那很正常啊，没有出现错误，如果不能建立索引，是不是你输入的内容中根本就没有关键词啊。
测试方法：新开一个word，随便输入一些内容，但必须包含学校、编辑2个关键词，然后复制下面的代码到当前document的vba里，
运行test会立即看到效果的。
Sub Test() BiaoJiAll ""编辑|学校"" ''End SubSub BiaoJiAll(ByVal bStr As String) ''bStr为关键词，用|分割 On Error Resume Next Dim i As Long w1 As String ww ww = Split(bStr|"") If UBound(ww) >= 0 Then For i = 0 To UBound(ww) Selection.HomeKey Unit:=wdStory ''移动到开始 With Selection.Find .ClearFormatting .Text = ww(i) .Execute If .Found Then ''如果找到了则添加到索引 ActiveDocument.Indexes.MarkAllEntries Range:=Selection.Range Entry:= _ ww(i) EntryAutoText:=ww(i) CrossReference:="""" CrossReferenceAutoText _ :="""" BookmarkName:="""" Bold:=False Italic:=False End If End With Next ''定位到最后 Selection.EndKey Unit:=wdStory ''在文档最后插入索引 ThisDocument.Indexes.Add Range:=Selection.Range HeadingSeparator:= _ wdHeadingSeparatorNone Type:=wdIndexIndent RightAlignPageNumbers:= _ True NumberOfColumns:=2 SortBy:=wdIndexSortByStroke IndexLanguage _ :=wdSimplifiedChinese End IfEnd Sub