VPF::[VBA] сравнение и выделение слов

Metalex

Дата 22.12.2009, 01:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 635
Регистрация: 22.10.2008
Где: Украина-ZPсity

Репутация: нет
Всего: нет

Написати програму, що в документі MS Word знаходить усі задані користувачем слова та встановлює наступні параметри шрифту цих слів: тип шрифту – Arial, розмір – 20 пт, жирний, колір – зелений. Також розроблювана програма повинна виділяти курсивом всі слова абзацу, що містить найбільшу кількість заданих слів.
Перевод:
Написать программу, которая в документе ворда находит все заданые пользоватем слова и устанавливает следующие параметсы шрифта этих слов: тип шрифта - ариал, кегль - 20, жирный, цвет - зеленый. Также программа должна выделять курсивом все слова абзаца, который содержит наибольшее кол-во заданных слов.

Итак, у меня есть TextBox1, за ним идет текст, а под текстом находится кнопка. Пользователь должен ввести слово (пока пусть будет одно) и нажать на кнопку. Совпадающие слова выделяются, абзац с наиб. кол-вом таких слов выделяется. smile

Я попытался реализовать только первую часть задания.... ВБ практически не знаю, так что не смейтесь. Помогите с решением.

Код

Private Sub CommandButton1_Click()
With ActiveDocument
If ActiveDocument.Range = TextBox1.Text Then
With ActiveDocument.Range
.Font.Name = "Arial"
.Font.Size = 20
.Font.ColorIndex = wdGreen
.Font.Bold = 1
End With
End If
End With

End Sub

Файл с набросками прикреплен..

Присоединённый файл ( Кол-во скачиваний: 7 )

VBA_lr_8.4.doc 39,00 Kb

--------------------

Don't let the system get you down.

kapbepucm

Дата 22.12.2009, 14:11 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 6
Всего: 12

Код

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
End Sub

--------------------

(С) kapbepucm

Metalex

Дата 22.12.2009, 22:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 635
Регистрация: 22.10.2008
Где: Украина-ZPсity

Репутация: нет
Всего: нет

kapbepucm, спасибо огромное!
Кому не сложно, прокомментируйте, пожалуйста, вышенаписанный код и осталась вторая часть: выделить курсивом все слова абзаца, который содержит наибольшее кол-во заданных слов.
Благодарю!

--------------------

Don't let the system get you down.

kapbepucm

Дата 23.12.2009, 13:56 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 6
Всего: 12

Дополнение, пока без комментов

Код

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

--------------------

(С) kapbepucm

Metalex

Дата 23.12.2009, 14:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 635
Регистрация: 22.10.2008
Где: Украина-ZPсity

Репутация: нет
Всего: нет

kapbepucm, попытаюсь разобратся. Благодарю!

--------------------

Don't let the system get you down.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »