Kazalo označenih besed

[alan07]

V wordu bi rad naredil kazalo ključnih besed. To se da narediti s pomočjo menija "Vstavljanje", potem pa izberem vsako besedo, ...., Na koncu mi te besede lepo izpiše po abecednem redu v stolpcih, desno od njih je še številka strani.
Ravno tako bi rad imel izpisano besede, ki bi jih prej označil z barvo (rdeče). Napisal sem tudi makro, ne znam pa dodati lastnosti besed, na kateri strani so.
Prosim za pomoč! Pa še, če bi bile sortirane po abecednem redu!
LP Alan


Sub Napisi_oznacene_besede()

For Each beseda In ActiveDocument.Words

If beseda.Font.Color = wdColorRed Then
oznbeseda = beseda & oznbeseda
End If

Next beseda

Word.Selection.InsertAfter Text:=oznbeseda
End Sub

[admin]

V splošnem makrov ne pišem, ker bi na forumu sicer lahko počel samo to, pa še živeti je potrebno od nečesa ... No kakorkoli vaša ideja pa je zanimiva zato imate spodaj celoten marko, ki vam na mesto kazalca vstavi celoten slovar označenih besed in ustreznih strani ter jih loči s tabulatorji...

Koda: Izberi vse

Const dictKey = 1
Const dictItem = 2

'
'  www.matjazev.net
'   april 2011
'
Sub VstaviSlovarOznacenihBesed()
  Dim slovar: Set slovar = CreateObject("Scripting.Dictionary")
  
  Dim beseda, vsebina
  For Each beseda In ActiveDocument.Words
    If beseda.Font.Color = wdColorRed Then
      If (slovar.Exists(beseda.Text)) Then
        vsebina = slovar(beseda.Text) & ", " & beseda.Information(wdActiveEndPageNumber)
        slovar.Remove beseda.Text
      Else
        vsebina = beseda.Information(wdActiveEndPageNumber)
      End If
      
      slovar(beseda.Text) = vsebina
    End If
  Next beseda

  SortDictionary slovar, dictKey
  
  Dim vstavi
  For Each beseda In slovar.keys
    vstavi = vstavi & beseda & Chr(9) & slovar(beseda) & Chr(13) & Chr(10)
    ' Debug.Print beseda, slovar(beseda)
  Next
  Word.Selection.InsertAfter Text:=vstavi

End Sub

' funkcija iz MSDN
Function SortDictionary(objDict, intSort)
  ' declare our variables
  Dim strDict()
  Dim objKey
  Dim strKey, strItem
  Dim X, Y, Z

  ' get the dictionary count
  Z = objDict.Count

  ' we need more than one item to warrant sorting
  If Z > 1 Then
    ' create an array to store dictionary information
    ReDim strDict(Z, 2)
    X = 0
    ' populate the string array
    For Each objKey In objDict
        strDict(X, dictKey) = CStr(objKey)
        strDict(X, dictItem) = CStr(objDict(objKey))
        X = X + 1
    Next

    ' perform a a shell sort of the string array
    For X = 0 To (Z - 2)
      For Y = X To (Z - 1)
        If StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare) > 0 Then
            strKey = strDict(X, dictKey)
            strItem = strDict(X, dictItem)
            strDict(X, dictKey) = strDict(Y, dictKey)
            strDict(X, dictItem) = strDict(Y, dictItem)
            strDict(Y, dictKey) = strKey
            strDict(Y, dictItem) = strItem
        End If
      Next
    Next

    ' erase the contents of the dictionary object
    objDict.RemoveAll

    ' repopulate the dictionary with the sorted information
    For X = 0 To (Z - 1)
      objDict.Add strDict(X, dictKey), strDict(X, dictItem)
    Next

  End If

End Function

[alan07]

Hvala za tako hiter odgovor, sicer še nisem sprobal, verjamem pa, da deluje. Se bom spravil na delo.
LP Alan