Дополнение, пока без комментов| Код | Private Sub CommandButton1_Click()
Dim MyRange As Object
Set MyRange = ActiveDocument.Content
MyRange.Find.ClearFormatting
MyRange.Find.Execute FindText:=TextBox1.Text, Forward:=True
Do Until MyRange.Find.Found = False
MyRange.Bold = True
MyRange.Font.Color = wdColorGreen
MyRange.Font.Name = "Arial"
MyRange.Font.Size = 20
MyRange.Find.Execute FindText:=TextBox1.Text, Forward:=True
Loop
Set MyRange = Nothing
'=================================================
Dim MyParagraph As Word.Paragraph
Dim MaxParagraph As Word.Paragraph, MaxCount As Long
Dim Count As Long, Pos As Long
For Each MyParagraph In ActiveDocument.Content.Paragraphs
Pos = 0
Do
Pos = InStr(Pos + 1, MyParagraph.Range.Text, TextBox1.Text, vbTextCompare)
If Pos <> 0 Then
Count = Count + 1
End If
Loop Until Pos = 0
If Count > MaxCount Then
Set MaxParagraph = MyParagraph
MaxCount = Count
End If
Count = 0
Next MyParagraph
MaxParagraph.Range.Italic = True
End Sub |
Добавлено через 14 минут и 28 секунд
Немного откомментил, но мой талант комментатора не очень...| Код | Private Sub CommandButton1_Click()
Dim MyRange As Object'объявление переменной
Set MyRange = ActiveDocument.Content'получаем доступ к объекту
MyRange.Find.ClearFormatting'чистим "искалку"
MyRange.Find.Execute FindText:=TextBox1.Text, Forward:=True'находим первое совпадение
Do Until MyRange.Find.Found = False'запускаем цикл, пока искать станет нечего
MyRange.Bold = True'тут и далее меняем шрифт
MyRange.Font.Color = wdColorGreen
MyRange.Font.Name = "Arial"
MyRange.Font.Size = 20
MyRange.Find.Execute FindText:=TextBox1.Text, Forward:=True'опять ищем
Loop
Set MyRange = Nothing'чистим переменную (не обязательно)
'=================================================
Dim MyParagraph As Word.Paragraph'объявляем переменные
Dim MaxParagraph As Word.Paragraph, MaxCount As Long
Dim Count As Long, Pos As Long
For Each MyParagraph In ActiveDocument.Content.Paragraphs'переберём в цикле все абзацы
'в каждом абзаце посмотрим ещё раз совпадения, посчитаем их
'короче, ищем абзац с наибольшим количеством совпадений
Pos = 0
Do
Pos = InStr(Pos + 1, MyParagraph.Range.Text, TextBox1.Text, vbTextCompare)
If Pos <> 0 Then
Count = Count + 1
End If
Loop Until Pos = 0
If Count > MaxCount Then
Set MaxParagraph = MyParagraph
MaxCount = Count
End If
Count = 0
Next MyParagraph
MaxParagraph.Range.Italic = True'ну, и в конце концов, ставим курсив в нужном обзаце
End Sub |
|
Я попытался реализовать только первую часть задания.... ВБ практически не знаю, так что не смейтесь. Помогите с решением.