Поиск нужной таблицы и выделение текста по заданным условиям

@Vikulenochek · Регистрация: 18.01.2012

Author24 — интернет-сервис помощи студентам

подскажите пожалуйста

Необходимо написать макрос в котором:
1)найти нужную таблицу (у каждой таблицы есть заголовок, у нужной-термины. после заголовка и идет необходимая таблица),
2)пробежаться по строкам и в тех строках, где второй столбец не заполнен выделить текст в первом столбце цветом (смотреть нужно по длине строки, т.к. там, возможно, присутствуют какие-то служебные символы, т.е. ячейка окажется не пустой, но строка будет короткой: 1 или 2 символа).

@Busine2012 · 18.01.2012, 07:09

Vikulenochek,
образец файла выкладывайте. Оставьте в файле только те данные, которые необходимы, чтобы можно было написать код.

@Vikulenochek · 18.01.2012, 08:13 **[ТС]**

файл во вложении

@Busine2012 · 18.01.2012, 08:55

Заголовки должны быть оформлены стилем Заголовок 3 (как у вас во вложенном файле).

Visual Basic

Sub Процедура1()
    Dim strHeader As String
    Dim lngTableNumber As Long
    Dim objCell As Word.Cell
    Dim bFlag As Boolean
    strHeader = InputBox("Какой заголовок искать?")
    If strHeader = "" Then
        Exit Sub
    End If
    With ActiveDocument.Content.Find
        .Text = strHeader
        .Style = "Заголовок 3"
        .Format = True
        If .Execute = False Then
            MsgBox "Такого заголовка нет в документе!", vbInformation
            Exit Sub
        Else
            lngTableNumber = ActiveDocument.Range(Start:=0, End:=.Parent.End).Tables.Count + 1
        End If
    End With
    For Each objCell In ActiveDocument.Tables(lngTableNumber).Columns(2).Cells
        If Len(Trim(objCell.Range.Text)) < 3 Then
            objCell.Previous.Shading.BackgroundPatternColor = wdColorRed
            bFlag = True
        End If
    Next objCell
    If bFlag = True Then
        MsgBox "Были найдены пустые ячейки!", vbCritical
    Else
        MsgBox "Не было найдено пустых ячеек!", vbInformation
    End If
End Sub

@Vikulenochek · 18.01.2012, 10:45 **[ТС]**

Busine2012,
а возможно ли чтобы он не спрашивал какой заголовок искать. заголовок необходимой таблицы всегда один и тот же (его имя термины)?

@Busine2012 · 18.01.2012, 10:51

В 6 строке:

Visual Basic

1	strHeader = "Термины"

Строки 7 - 9 удалите.

@Vikulenochek · 30.01.2012, 04:44 **[ТС]**

Вот что получилось, в итоге выделяет всю левую колонкутаблицы. Подскажите пожалуйста, что нужно сделать чтобы корректно работало?

Visual Basic

Sub Ïðîöåäóðà1()
    Dim strHeader As String
    Dim lngTableNumber As Long
    Dim objCell As Word.Cell
    Dim bFlag As Boolean
    strHeader = "Òåðìèíû"
    
        With ActiveDocument.Content.Find
        .Text = strHeader
        .Style = "Çàãîëîâîê 3"
        .Format = True
        If .Execute = False Then
            MsgBox "Òàêîãî çàãîëîâêà íåò â äîêóìåíòå!", vbInformation
            Exit Sub
        Else
            lngTableNumber = ActiveDocument.Range(Start:=0, End:=.Parent.End).Tables.Count + 2
        End If
    End With
    For Each objCell In ActiveDocument.Tables(lngTableNumber).Columns(2).Cells
        If Len(Trim(objCell.Range.Text)) < 3 Then
            objCell.Previous.Shading.BackgroundPatternColor = wdColorRed
            bFlag = True
        End If
    Next objCell
    If bFlag = True Then
        MsgBox "Áûëè íàéäåíû ïóñòûå ÿ÷åéêè!", vbCritical
    Else
        MsgBox "Íå áûëî íàéäåíî ïóñòûõ ÿ÷ååê!", vbInformation
    End If
End Sub

@Busine2012 · 31.01.2012, 15:37

Visual Basic

Sub Процедура1()
    'Если в ходе выполнения кода текст в переменной не меняется,
    'то надо эту переменную превратить в константу (так логичнее просто).
    Const strHeader As String = "Термины"
    Dim lngTableNumber As Long
    Dim objCell As Word.Cell
    Dim boolFlag As Boolean
    With ActiveDocument.Content.Find
        .Text = strHeader
        .Style = "Заголовок 3"
        .Format = True
        If .Execute = False Then
            MsgBox "Такого заголовка нет в документе!", vbInformation
            Exit Sub
        Else
            'Здесь определяем: сколько таблиц находится от начала документа
            'до места, где находится заголовок Термины.
            'Следующая таблица будет наша, поэтому +1
            lngTableNumber = ActiveDocument.Range(Start:=0, End:=.Parent.End).Tables.Count + 1
        End If
    End With
    For Each objCell In ActiveDocument.Tables(lngTableNumber).Columns(2).Cells
        If Len(Trim(objCell.Range.Text)) < 3 Then
            objCell.Previous.Shading.BackgroundPatternColor = wdColorRed
            boolFlag = True
        End If
    Next objCell
    If boolFlag = True Then
        MsgBox "Были найдены пустые ячейки!", vbCritical
    Else
        MsgBox "Не было найдено пустых ячеек!", vbInformation
    End If
End Sub

@Vikulenochek · 13.02.2012, 02:59 **[ТС]**

Busine2012, спасибо

@Vikulenochek 0 / 0 / 0 Регистрация: 18.01.2012 Сообщений: 5
		1
	Поиск нужной таблицы и выделение текста по заданным условиям 18.01.2012, 04:32. Показов 1904. Ответов 8 Метки нет (Все метки) подскажите пожалуйста Необходимо написать макрос в котором: 1)найти нужную таблицу (у каждой таблицы есть заголовок, у нужной-термины. после заголовка и идет необходимая таблица), 2)пробежаться по строкам и в тех строках, где второй столбец не заполнен выделить текст в первом столбце цветом (смотреть нужно по длине строки, т.к. там, возможно, присутствуют какие-то служебные символы, т.е. ячейка окажется не пустой, но строка будет короткой: 1 или 2 символа). 0

@Busine2012 1300 / 402 / 22 Регистрация: 21.10.2011 Сообщений: 1,285
	18.01.2012, 07:09	2
	Vikulenochek, образец файла выкладывайте. Оставьте в файле только те данные, которые необходимы, чтобы можно было написать код. 0

@Vikulenochek 0 / 0 / 0 Регистрация: 18.01.2012 Сообщений: 5
	18.01.2012, 10:45 [ТС]	5
	Busine2012, а возможно ли чтобы он не спрашивал какой заголовок искать. заголовок необходимой таблицы всегда один и тот же (его имя термины)? 0

@Vikulenochek 0 / 0 / 0 Регистрация: 18.01.2012 Сообщений: 5
	13.02.2012, 02:59 [ТС]	9
	Busine2012, спасибо 0