Reply
 
Thread Tools Display Modes
  #1   Report Post  
zalek
 
Posts: n/a
Default VBA macro to create an index

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

Reply
Thread Tools
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Create see and see also references in an index? Duchesse Microsoft Word Help 2 April 1st 08 09:34 PM
VBA macro to create an index zalek New Users 0 August 16th 05 06:06 PM
Creating A Macro To Create Address Labels Jerry Slocombe Mailmerge 9 July 11th 05 09:58 PM
How do I create a template for Ready Index Dividers 31 tab Avery Humanist Microsoft Word Help 2 July 4th 05 04:15 AM
How do I create a macro to data sort in a table within a protecte. Keenly52 Tables 5 March 29th 05 08:38 AM


All times are GMT +1. The time now is 09:48 AM.

Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 Microsoft Office Word Forum - WordBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Word"