Z
zalek
I wrote a macro that creates an index.
Here is an explanation:
I have a text and a file c:\boss_info_index.txt that have a keywords I
want to index in the text file. Keywords in the file have no duplicates
and are in descending orders - I am not sure if the order is relevant,
but there should be no duplicates.
Here is the macro:
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
Here is an explanation:
I have a text and a file c:\boss_info_index.txt that have a keywords I
want to index in the text file. Keywords in the file have no duplicates
and are in descending orders - I am not sure if the order is relevant,
but there should be no duplicates.
Here is the macro:
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