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
Kazalo označenih besed
Re: Kazalo označenih besed
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
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Kazalo označenih besed
Hvala za tako hiter odgovor, sicer še nisem sprobal, verjamem pa, da deluje. Se bom spravil na delo.
LP Alan
LP Alan