Windows 7, Word 2010 и 2016
У меня есть макрос, который ищет в моем документе какой-то текст, и когда он найден, добавьте этот текст в индекс. Идея состоит в том, что у меня есть много определений (формат: [word] - means [definition]), и я хотел бы бросить все это в указатель, чтобы я мог эффективно получить словарь в конце.
Однако, когда он запускается и создает индекс, он составляет около 90% в альфа-порядке, но некоторые записи находятся в случайных местах. Насколько я могу судить, нет причин, по которым они должны быть в неправильном порядке. (В моем разделе слов "А" есть слово, которое начинается с "С" или что-то иное, чем "А").
Вот фрагмент кода, который добавляет их в индекс (я вытащил это из более крупного макроса, но дайте мне знать, если вы хотите все это):
myDoc.Indexes.MarkEntry Range:=rng, entry:=editedDefinition, entryautotext:=editedDefinition
myDoc - это Word.Document (myDoc = ActiveDocument).
rng - это Word.Range
editedDefinition - это String .
У меня есть предчувствие, что добавление моей строки в индекс слишком просто. Нужна ли более точная информация?
Кроме того, что бы ни стоило, кажется, индекс только позволяет добавить до некоторого количества символов (по некоторым причинам он обрезает некоторые определения).
Изменить: Вот основной макрос (вы заметите, что я вызываю UDF, пожалуйста, дайте мне знать, если вам это тоже нужно):
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
Изменить: (За комментарий) Я думаю, что нашел проблему! Поискав в интернете, я нашел этот пост, который, похоже, является моей проблемой! Я выполнил тест и удалил точку с запятой из одной из записей, вышедших из строя, и она была помещена в правильное место. Теперь мне просто нужно выяснить, как рассмотреть; в моем добавлении к индексу. У меня все еще зеленый Word VBA, поэтому любые идеи / советы будут оценены.
Edit2: вот мои UDF:
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