У меня есть макрос VBA для Microsoft Word, который я пытаюсь улучшить.
Целью макроса является выделение жирным шрифтом и курсивом всех слов в документе, которые соответствуют условиям поиска в первой таблице документа.
Проблема состоит в том, что условия поиска включают в себя следующие символы:
дефис "-": между буквами подстановочный знак для пробела или точки
звездочка "&": (сайт не позволяет мне ставить звездочки, поскольку это уценка для курсива, поэтому вместо символов я добавлю символ &, чтобы обойти фильтры), подстановочный знак для любого числа символов в начало слова или в конце. В отличие от обычных языков программирования, когда он используется в середине слова, его необходимо объединить с дефисом, чтобы он был подстановочным знаком для ряда символов. Например, «th & -e» будет подбирать «там», а «th & e» - нет.
вопросительный знак "?": Подстановочный знак для одного символа
Что я делаю до сих пор, так это просто проверяю эти символы, и, если они присутствуют, я либо сбрасываю их в случае звездочки, либо предупреждаю пользователя, что он должен искать слово вручную. Не идеально: -P
Я пробовал свойство .MatchWildcard в VBA, но пока не заставил его работать. У меня такое ощущение, что это связано с текстом замены, а не с текстом поиска.
Рабочий макрос примет следующее в качестве входных данных (первая строка преднамеренно игнорируется, а второй столбец - это столбец с целевыми поисковыми терминами):
Представьте себе это в виде таблицы во втором столбце (поскольку разрешенный здесь html не допускает tr, td и т. Д.)
Первый ряд: слово
Второй ряд: Поиск
Третий ряд: & earch1
Четвертый ряд: Search2 &
Пятый ряд: S-earch3
Шестой ряд: S? Arch4
Седьмой ряд: S & -ch5
И он будет искать документ и заменять его жирным шрифтом и курсивом, например, так:
Поиск Поиск1 Поиск2 Поиск3 Поиск4 Поиск5
Примечание: S-earch3 также может получить S.earch3 и заменить на Search3
Как можно предположить, поисковые термины обычно не будут рядом друг с другом - макрос должен найти все экземпляры.
Я включу свой попытанный, но нефункциональный код и после первого рабочего макроса.
Код рабочего макроса будет находиться на pastebin в течение месяца с сегодняшнего дня, 17.09.09, по следующему адресу: url .
Еще раз спасибо за любые мысли и помощь, которую вы можете предложить!
Sara
Рабочий макрос VBA:
Sub AllBold()
Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim celColl As Cells
Dim i As Integer
Dim rngLen As Integer
Dim bolWild As Boolean
Dim strWild As String
Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
strWild = ""
For i = 1 To intCount
If i = 1 Then
i = i + 1
End If
Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
rngLen = Len(rngTable.Text)
bolWild = False
If (Mid(rngTable.Text, rngLen, 1) = "&") Then 'remember to replace & with asterisk!'
rngTable.SetRange Start:=rngTable.Start, End:=rngTable.End - 1
End If
If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'
rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End
End If
If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then
strWild = strWild + rngTable.Text + Chr$(13)
bolWild = True
End If
If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then
strWild = strWild + rngTable.Text + Chr$(13)
bolWild = True
End If
If (bolWild = False) Then
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = rngTable.Text
With .Replacement
.Text = rngTable.Text
.Font.Bold = True
.Font.Italic = True
End With
.Execute Replace:=wdReplaceAll
End With
End If
Next
If bolWild = True Then
MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)
End If
End Sub
Попытка нефункционального макроса VBA:
Sub AllBoldWildcard()
Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim celColl As Cells
Dim i As Integer
Dim rngLen As Integer
Dim bolWild As Boolean
Dim strWild As String
Dim strWildcard As String
Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
strWild = ""
For i = 1 To intCount
If i = 1 Then
i = i + 1
End If
Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
rngLen = Len(rngTable.Text)
bolWild = False
If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'
rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End
End If
If InStr(1, rngTable.Text, "&", vbTextCompare) > 0 Then 'remember to replace & with asterisk!'
strWildcard = rngTable.Text
rngTable.Text = Replace(rngTable.Text, "&", "", 1) 'remember to replace & with asterisk!'
bolWild = True
End If
If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then
strWildcard = Replace(rngTable.Text, "-", "[.-]", 1)
bolWild = True
End If
If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then
strWild = strWild + rngTable.Text + Chr$(13)
strWildcard = Replace(rngTable.Text, "?", "_", 1)
bolWild = True
End If
If (bolWild = False) Then
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = strWildcard
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
With .Replacement
.Text = rngTable.Text
.Font.Bold = True
.Font.Italic = True
End With
.Execute Replace:=wdReplaceAll
End With
End If
Next
' If bolWild = True Then'
' MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)'
' End If'
End Sub