Windows 7, Word 2010 e amp; 2016
Eu tenho uma macro que pesquisa meu documento em busca de algum texto e, quando encontrada, adiciona esse texto a um índice. A ideia é que eu tenho muitas definições (formato: [word] - means [definition] ) e gostaria de lançar todas elas em um Index, então posso efetivamente ter um dicionário no final.
No entanto, quando é executado e cria o índice, é cerca de 90% na ordem Alpha, mas algumas entradas estão em lugares aleatórios. Tanto quanto eu posso dizer, não há razão para que eles devam estar na ordem errada. (Na minha seção de palavras "A", há uma palavra que começa com "C" ou algo diferente de "A").
Aqui está o clipe do código que está adicionando-os ao índice (eu tirei isso de uma macro maior, mas me avise se você quiser a coisa toda):
myDoc.Indexes.MarkEntry Range:=rng, entry:=editedDefinition, entryautotext:=editedDefinition
myDoc é Word.Document ( myDoc = ActiveDocument ).
rng é Word.Range % editedDefinition é String .
Tenho um palpite de que minha linha adicionando ao índice é muito simples. Precisa de informações mais explícitas?
Além disso, pelo que vale a pena, parece que o índice só permite adicionar até um número de caracteres (corta algumas definições por algum motivo).
Edit: Aqui está a macro principal (você notará que eu chamo uma UDF, por favor me avise se você precisar também):
Sub Find_Definitions()
Dim myDoc As Word.Document
Dim oRng As Word.Range, rng As Word.Range
Dim addDefinition$, findText$, editedDefinition$
Set myDoc = ActiveDocument
Call Clear_Index
findText = InputBox("What term would you like to search for?")
If findText = "" Then Exit Sub
'Loop through the document
Set oRng = myDoc.Content
With oRng.Find
.ClearFormatting
.Text = findText
.MatchCase = False
.Wrap = wdFindStop
While .Execute
Set rng = oRng.Paragraphs(1).Range
rng.Select
Dim searchText$
searchText = "- Non- USA"
If Left(rng.Text, Len(searchText)) = searchText Then
Debug.Print ""
End If
' Here's where I could check the text, and see if it starts with Roman numerals.
editedDefinition = Check_For_Roman_Numerals(rng, findText)
' Check to see if we're in the 'Definitions' section
If rng.Information(wdActiveEndSectionNumber) >= myDoc.Sections.Count - 1 Then
GoTo TheEnd
End If
myDoc.Indexes.MarkEntry Range:=rng, entry:=editedDefinition, entryautotext:=editedDefinition
Wend 'end .execute
End With 'oRng.find
TheEnd:
Set rng = Nothing
myDoc.Indexes(1).Update
MsgBox ("Added all definitions.")
End Sub
Editar: (por comentário)
Eu acho que encontrei o problema! Depois de vasculhar on-line, achei este post que parece ser o meu problema! Fiz um teste e removi um ponto-e-vírgula de uma das entradas fora de ordem e a coloquei no lugar correto. Agora, só preciso descobrir como considerar um; na minha adição ao índice. Eu ainda sou verde com o Word VBA, então quaisquer idéias / dicas serão apreciadas.
Edit2: aqui estão meus UDFs:
Private Function Check_For_Roman_Numerals(ByVal mySelection As Word.Range, searchString As String) As String
Dim romanNumerals() As Variant
Dim firstWord$, paragraphsText As Variant, xWord As Variant
Dim oWord As Word.Range
Dim i&, x&
romanNumerals = Array("i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix", "x", "xi", "xii")
Dim editedSelection
Dim moveStart As Variant
Dim myEditedSelection As Variant
Dim addedOnce As Boolean
'editedSelection = mySelection.Text
x = 0
addedOnce = False
With mySelection
Debug.Print mySelection.Text
' Edit selection to include only the start where it's underlined
On Error Resume Next
Do Until mySelection.Characters(x + 1).Font.Underline = wdUnderlineSingle Or mySelection.Characters(x + 1).Font.Underline = wdUnderlineDouble
If (x + 1) > mySelection.Characters.Count Then Exit Do
Debug.Print "'" & mySelection.Characters(x + 1) & "' is not underlined"
x = x + 1
Loop
On Error GoTo 0
Set myEditedSelection = mySelection.Duplicate '= mySelection.moveStart(unit:=wdWord, Count:=x)
With myEditedSelection
.moveStart unit:=wdCharacter, Count:=x
.Select
End With 'myEditedSelection
For i = LBound(romanNumerals) To UBound(romanNumerals)
If (mySelection.Words(1) = romanNumerals(i)) Or (mySelection.Words(1) = romanNumerals(i) & ".") Then
Debug.Print "Found roman numeral " & mySelection.Words(1)
moveStart = trim_Roman_Text(mySelection.Text, searchString, myEditedSelection.moveStart(unit:=wdCharacter, Count:=x) + 1)
editedSelection = moveStart
Debug.Print "Adding: """ & editedSelection & """ to Index"
Exit For
ElseIf Not addedOnce Then
moveStart = trim_Text(mySelection.Text, searchString, myEditedSelection.moveStart(unit:=wdCharacter, Count:=x) + 1)
editedSelection = Trim(moveStart)
addedOnce = True
End If
Next i
End With 'mySelection
Check_For_Roman_Numerals = editedSelection
End Function
Private Function trim_Text(ByVal myText As String, mySearch As String, startPos As Integer) As String
Dim finalText$
Dim sentenceEndPosition&, meansPos&
meansPos = InStr(1, myText, mySearch)
sentenceEndPosition = InStr(meansPos, myText, ".")
If sentenceEndPosition = 0 Then
sentenceEndPosition = InStr(meansPos, myText, ";")
End If
If sentenceEndPosition = 0 Then
sentenceEndPosition = InStr(meansPos, myText, ":")
End If
If sentenceEndPosition = 0 Then
sentenceEndPosition = InStr(meansPos, myText, Chr(13))
End If
If sentenceEndPosition = 0 Then
MsgBox ("What is the end of the paragraph?")
End If
finalText = Trim(Mid(myText, startPos, sentenceEndPosition))
trim_Text = finalText
End Function
Private Function trim_Roman_Text(ByVal myText As String, ByVal mySearch As String, startPos As Integer) As String
Dim finalText$
Dim romanNumeralEndPosition&, sentenceEndPosition$, meansPos&
'myText = "i. Australia - means the subcontinent. It is located below Asia, and this is what it looks like. A giant circle with some odd edges."
meansPos = InStr(1, myText, mySearch)
romanNumeralEndPosition = InStr(1, myText, ".")
'Debug.Print romanNumeralEndPosition
sentenceEndPosition = InStr(romanNumeralEndPosition + 1, myText, ".")
If sentenceEndPosition = 0 Then
sentenceEndPosition = InStr(romanNumeralEndPosition + 1, myText, ";")
End If
If sentenceEndPosition = 0 Then
sentenceEndPosition = InStr(romanNumeralEndPosition + 1, myText, ":")
End If
If sentenceEndPosition = 0 Then
sentenceEndPosition = InStr(romanNumeralEndPosition + 1, myText, Chr(13))
End If
'Debug.Print sentenceEndPosition
finalText = Trim(Mid(myText, romanNumeralEndPosition + 1, sentenceEndPosition - romanNumeralEndPosition))
'Debug.Print finalText
trim_Roman_Text = finalText
End Function