Получение подстановочных знаков для работы в функции поиска и замены в макросе VBA для Microsoft Word
У меня есть макрос VBA для Microsoft Word, который я пытаюсь улучшить.
Целью макроса является выделение жирным шрифтом и курсивом всех слов в документе, которые соответствуют условиям поиска в первой таблице документа.
Проблема состоит в том, что условия поиска включают в себя следующие символы:
дефис "-": между буквами подстановочный знак для пробела или точки
звездочка "&": (сайт не позволяет мне ставить звездочки, так как это уценка для курсива, поэтому явставлю в & вместо символа, чтобы обойти фильтры) подстановочный знак для любого количества символов в начале слова или в конце. В отличие от обычных языков программирования, когда он используется в середине слова, его необходимо объединить с дефисом, чтобы он был подстановочным знаком для ряда символов. Например "й и-e» взял бытам" в то время как "й и е» не будет.
вопросительный знак "?": подстановочный знак для одного символа
Что я делаю до сих пор, так это просто проверяю эти символы, и если они присутствуют, я либо обрезаю их в случае звездочки, либо предупреждаю пользователя, что ему нужно искать слово вручную. Не идеально :-P
Я пробовал свойство .MatchWildcard в VBA, но еще не заставил его работать. У меня такое чувство, что это связано с текстом замены, а не с текстом поиска.
Рабочий макрос примет следующее в качестве входных данных (первая строка намеренно игнорируется, а вторая - та, что содержит целевые поисковые термины):
Представьте себе это в виде таблицы во втором столбце (так как здесь разрешено использование HTML).т разрешить тр и тд и т. д.)
Первый ряд: слово
Второй ряд: Поиск
Третий ряд: &earch1
Четвертый ряд: Search2 &
Пятый ряд: S-earch3
Шестой ряд: S? Arch4
Седьмой ряд: S &-ch5
И он будет искать документ и заменять его жирным шрифтом и курсивом следующим образом:
Поиск Поиск1 Поиск2 Поиск3 Поиск4 Поиск5
Примечание: S-earch3 также может получить S.earch3 и заменить на Search3
Как можно предположить, поисковые термины обычно не будут находиться рядом друг с другом - макрос должен найти все экземпляры.
Я включу свой попытанный, но нефункциональный код после первого рабочего макроса.
Код для рабочего макроса будет находиться на pastebin в течение месяца с сегодняшнего дня, 17.09.09, в следующемURL-адрес.
Еще раз спасибо за любые мысли и помощь, которую вы можете предложить!
Сара
Рабочий макрос 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