Доброе время суток 
Помогите, пожалуйста, с заданием. Необходимо найти выделенный определенным цветом текст в документе Word и скопировать его в Excel, где каждому цвету будет соответствовать свой лист. Каждое новое выделение ворда копируется в следующую ячейку экселя. Причем макрос нужно написать в экселе, а файл ворда должен быть формата doc/docx. Я новичок в VBA, поэтому алгоритм вижу таким:
1) Поиск выделенного красным цветом текста
2) Его сохранение в переменную
3) Вставка текста в первую ячейку
4) Поиск следующего выделенного красным цветом текста по документу и повторение первых трех пунктов до конца документа
5) Затем те же пункты для других цветов
Можно сделать сохранение переменных в список (List), но не знаю, есть ли такое в VBA.
С проблемой столкнулся, по канону, сразу на первом этапе. Нашел в инете способ и написал следующий код:
| Код |
|---|
Sub FindData() Dim rng As Range Set rng = ActiveDocument.Range With rng.Find '.ClearFormatting .Highlight = wdColorRed '.Font.Color = wdColorRed '.Format = True '.Text = "<.*>" .Wrap = wdFindContinue '.MatchWildcards = True .Execute End With MsgBox "" & rng.Text & " найден" End Sub |
| Код |
|---|
Sub InsertText()
Dim objWrdApp As Object
Dim objWrdDoc As Object
Dim text As Object
On Error Resume Next
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
Set objWrdApp = CreateObject("Word.Application")
End If
' путь, который прописывается в ячейке
Dim path As String
path = [H2]
Set objWrdDoc = objWrdApp.Documents.Open(path)
With objWrdDoc.Content.Find
'.ClearFormatting
.Highlight = wdColorRed
'.Font.Color = wdColorRed
'.Format = True
'.Text = "<.*>"
'.MatchWildcards = True
.Execute
End With
MsgBox "" & objWrdDoc.Content.text & " найден"
Set objWrdDoc = Nothing
Set objWrdApp = Nothing
End Sub
|
