Option Explicit Option Base 1 Dim Dim Dim Dim Dim Dim
kulcsszo As String tombSzam() As Integer tombSzoveg() As String tombIndex As Integer 'A mindenkori tömbméret. fodokuNev As String kulcsdokuNev As String
Sub Index_bejegyz_keszites() Static para As Paragraph Dim befejezes As Integer If Application.Documents.Count >= 1 Then fodokuNev = Word.Application.ActiveDocument.Name Call alcimekTarolasa MsgBox "Nyissa meg a kulcsszavakat tartalmazó állományt!" 'Ebben minden kulcsszót önálló bekezdésbe kell tenni! befejezes = Dialogs(wdDialogFileOpen).Show 'Ha a párbeszédablak bezárásával vagy a Mégse gombbal megyünk tovább, befejezzük a bejegyzések készítését. If befejezes = 0 Or befejezes = -2 Then Exit Sub End If 'Tájékoztatjuk a felhasználót: UserForm1.Show Else MsgBox "Nyissa meg az indexelendő dokumentumot!" End If End Sub Sub Fodoku() Dim paragr As Paragraph Dim bekSzam As Integer Dim tombFutoIndex As Integer
Dim jeloloSzoveg As String bekSzam = 0 jeloloSzoveg = "" 'Aktívvá tesszük az indexelendő állományt. Word.Application.Documents(fodokuNev).Activate For Each paragr In ActiveWindow.Document.Paragraphs bekSzam = 1 + bekSzam If paragr.Style <> "Hiperhivatkozás" And InStr(paragr.Style, "TJ") = 0 Then 'Indulhat a keresés a bekezdésben: paragr.Range.Select With Selection.Find .Forward = True .ClearFormatting .MatchWholeWord = True .MatchCase = False .Wrap = wdFindStop .Execute FindText:=kulcsszo End With 'Egy bekezdésben megelégszünk az első előfordulással. If Selection.Find.Found Then 'Van találat. Kezdődhet a "Jelölés". Selection.Collapse (wdCollapseEnd) 'Meg kell találni a közvetlenül felette lévő címsor stílusú bekezdés szövegét. 'Hátulról kell kezdeni a vizsgálatot, mert az első címsor előtt is lehet bevezető szöveg. For tombFutoIndex = tombIndex To 1 Step -1 If tombSzam(tombFutoIndex) <= bekSzam Then jeloloSzoveg = tombSzoveg(tombFutoIndex) Exit For End If Next tombFutoIndex 'Jelölő szöveg kialakítása: If jeloloSzoveg <> "" Then jeloloSzoveg = kulcsszo & ":" & jeloloSzoveg Else
jeloloSzoveg = kulcsszo End If 'Jöhet a mezőkód kialakítása: ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:= _ jeloloSzoveg, EntryAutoText:=jeloloSzoveg, CrossReference:="", _ CrossReferenceAutoText:="", BookmarkName:="", Bold:=False, Italic:=False End If End If jeloloSzoveg = "" Next paragr End Sub Sub alcimekTarolasa() Dim bek As Paragraph Dim bekSzam As Integer bekSzam = 0 tombIndex = 0 For Each bek In ActiveDocument.Paragraphs bekSzam = 1 + bekSzam If InStr(bek.Style, "Címsor") <> 0 Then 'Címsor stílust találtunk. tombIndex = 1 + tombIndex ReDim Preserve tombSzam(tombIndex) As Integer tombSzam(tombIndex) = bekSzam ReDim Preserve tombSzoveg(tombIndex) As String tombSzoveg(tombIndex) = bek.Range.Text End If Next bek End Sub Sub Kulcsdoku1() kulcsdokuNev = Word.Application.ActiveDocument.Name 'Elrejtjük a programot, hogy gyorsabb legyen a működés: Word.Application.Visible = False 'Előkészítjük a folyamatjelzőt:
Unload UserForm1 UserForm2.Show End Sub Sub Kulcsdoku2() Static para As Paragraph Dim kulcsszoSzam As Integer Dim bekSzam As Integer bekSzam = 0 kulcsszoSzam = ActiveWindow.Document.Paragraphs.Count 'Végigmegyünk a most megnyitott állomány minden bekezdésén: For Each para In ActiveWindow.Document.Paragraphs bekSzam = bekSzam + 1 kulcsszo = para.Range.Text kulcsszo = Trim(Replace(kulcsszo, Chr(13), "")) Call Fodoku Call Kijelzes(kulcsszoSzam, bekSzam) Word.Application.Documents(kulcsdokuNev).Activate Next para ActiveDocument.Close ActiveWindow.Selection.Collapse Call Vege2 End Sub Sub Vege2() Unload UserForm2 'Megjelenítjük az ablakot: Word.Application.Visible = True End Sub Sub Vege1() Unload UserForm1 'Megjelenítjük az ablakot: Word.Application.Visible = True
End Sub Sub Kijelzes(osszes, futo) Dim novekmeny As Single Dim b(20) As Boolean Dim i As Integer If osszes >= 20 Then novekmeny = osszes / 20 Select Case futo / novekmeny Case Is >= 20 UserForm2.Frame20.Visible = True Case Is >= 19 UserForm2.Frame19.Visible = True Case Is >= 18 UserForm2.Frame18.Visible = True Case Is >= 17 UserForm2.Frame17.Visible = True Case Is >= 16 UserForm2.Frame16.Visible = True Case Is >= 15 UserForm2.Frame15.Visible = True Case Is >= 14 UserForm2.Frame14.Visible = True Case Is >= 13 UserForm2.Frame13.Visible = True Case Is >= 12 UserForm2.Frame12.Visible = True Case Is >= 11 UserForm2.Frame11.Visible = True Case Is >= 10 UserForm2.Frame10.Visible = True Case Is >= 9 UserForm2.Frame9.Visible = True Case Is >= 8 UserForm2.Frame8.Visible = True Case Is >= 7
UserForm2.Frame7.Visible Case Is >= 6 UserForm2.Frame6.Visible Case Is >= 5 UserForm2.Frame5.Visible Case Is >= 4 UserForm2.Frame4.Visible Case Is >= 3 UserForm2.Frame3.Visible Case Is >= 2 UserForm2.Frame2.Visible Case Is >= 1 UserForm2.Frame1.Visible End Select
= True = True = True = True = True = True = True
Else novekmeny = 20 * futo / osszes For i = 1 To 20 If novekmeny >= i Then b(i) = True Else b(i) = False End If Next i UserForm2.Frame1.Visible = b(1) UserForm2.Frame2.Visible = b(2) UserForm2.Frame3.Visible = b(3) UserForm2.Frame4.Visible = b(4) UserForm2.Frame5.Visible = b(5) UserForm2.Frame6.Visible = b(6) UserForm2.Frame7.Visible = b(7) UserForm2.Frame8.Visible = b(8) UserForm2.Frame9.Visible = b(9) UserForm2.Frame10.Visible = b(10) UserForm2.Frame11.Visible = b(11) UserForm2.Frame12.Visible = b(12) UserForm2.Frame13.Visible = b(13)
UserForm2.Frame14.Visible UserForm2.Frame15.Visible UserForm2.Frame16.Visible UserForm2.Frame17.Visible UserForm2.Frame18.Visible UserForm2.Frame19.Visible UserForm2.Frame20.Visible End If End Sub
Vissza a magyarázathoz
= = = = = = =
b(14) b(15) b(16) b(17) b(18) b(19) b(20)
