Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Закраска разделов документа word, с учетом текста строки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Закраска разделов документа word, с учетом текста строки
Закраска разделов документа word, с учетом текста строки
Lizard Дата: Пятница, 17.05.2019, 08:47 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 56
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте.
У меня возник вопрос по ворду.

В документе - много текста.
Этот текст разделен строками, которые начинаются так : Число, точка, число, пробел, заглавная буква.

Как макросом закрасить текстовые разделы разделенные такими строками - в желтый и синий цвета ?
К сообщению приложен файл: 7372480.doc(31.5 Kb)
 
Ответить
СообщениеЗдравствуйте.
У меня возник вопрос по ворду.

В документе - много текста.
Этот текст разделен строками, которые начинаются так : Число, точка, число, пробел, заглавная буква.

Как макросом закрасить текстовые разделы разделенные такими строками - в желтый и синий цвета ?

Автор - Lizard
Дата добавления - 17.05.2019 в 08:47
krosav4ig Дата: Пятница, 17.05.2019, 11:38 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2148
Репутация: 893 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
[vba]
Код
Sub colorize()
    Dim p As Paragraph, prev&, b As Boolean
    Application.ScreenUpdating = 0
    With CreateObject("vbscript.regexp")
        .Global = False: .Pattern = "^\d+\.\d+\s"
        For Each p In ThisDocument.Paragraphs
            If .test(p.Range.Text) Then
                If prev > 0 Then
                    p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
                End If
                prev = p.Range.Start + 1
                b = Not b
            ElseIf p.Next Is Nothing Then
                p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
            End If
        Next
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
[vba]
Код
Sub colorize()
    Dim p As Paragraph, prev&, b As Boolean
    Application.ScreenUpdating = 0
    With CreateObject("vbscript.regexp")
        .Global = False: .Pattern = "^\d+\.\d+\s"
        For Each p In ThisDocument.Paragraphs
            If .test(p.Range.Text) Then
                If prev > 0 Then
                    p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
                End If
                prev = p.Range.Start + 1
                b = Not b
            ElseIf p.Next Is Nothing Then
                p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
            End If
        Next
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 17.05.2019 в 11:38
Lizard Дата: Пятница, 17.05.2019, 21:20 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 56
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, почему-то не работает.
Выдает ошибку:
Run-time error 4608: Значение лежит вне допустимого диапазона.

И подсвечивает строку:
[vba]
Код
p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
[/vba]

Как устранить эту ошибку ?
 
Ответить
Сообщениеkrosav4ig, почему-то не работает.
Выдает ошибку:
Run-time error 4608: Значение лежит вне допустимого диапазона.

И подсвечивает строку:
[vba]
Код
p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
[/vba]

Как устранить эту ошибку ?

Автор - Lizard
Дата добавления - 17.05.2019 в 21:20
Lizard Дата: Среда, 31.07.2019, 13:38 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 56
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, почему-то не работает.
Выдает ошибку:
Run-time error 4608: Значение лежит вне допустимого диапазона.

И подсвечивает строку:
[vba]
Код
p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
[/vba]

Как устранить эту ошибку ?
 
Ответить
Сообщениеkrosav4ig, почему-то не работает.
Выдает ошибку:
Run-time error 4608: Значение лежит вне допустимого диапазона.

И подсвечивает строку:
[vba]
Код
p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
[/vba]

Как устранить эту ошибку ?

Автор - Lizard
Дата добавления - 31.07.2019 в 13:38
Pelena Дата: Среда, 31.07.2019, 16:58 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 14329
Репутация: 3132 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Приложите файл с макросом и ошибкой


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПриложите файл с макросом и ошибкой

Автор - Pelena
Дата добавления - 31.07.2019 в 16:58
Lizard Дата: Пятница, 02.08.2019, 22:03 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 56
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, вот:
К сообщению приложен файл: 111-.doc(30.0 Kb)
 
Ответить
СообщениеPelena, вот:

Автор - Lizard
Дата добавления - 02.08.2019 в 22:03
krosav4ig Дата: Пятница, 02.08.2019, 22:26 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 2148
Репутация: 893 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Lizard, и чем содержимое этого файла отличается от файла из первого поста?


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеLizard, и чем содержимое этого файла отличается от файла из первого поста?

Автор - krosav4ig
Дата добавления - 02.08.2019 в 22:26
Lizard Дата: Понедельник, 05.08.2019, 10:02 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 56
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, вот этот код применительно к данному файлу:
[vba]
Код

Sub colorize()
    Dim p As Paragraph, prev&, b As Boolean
    Application.ScreenUpdating = 0
    With CreateObject("vbscript.regexp")
        .Global = False: .Pattern = "^\d+\.\d+\s"
        For Each p In ThisDocument.Paragraphs
            If .test(p.Range.Text) Then
                If prev > 0 Then
                    p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
                End If
                prev = p.Range.Start + 1
                b = Not b
            ElseIf p.Next Is Nothing Then
                p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
            End If
        Next
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Не работает.

Выдает ошибку:
Run-time error 4608: Значение лежит вне допустимого диапазона.

И подсвечивает строку:
[vba]
Код
p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
[/vba]


Сообщение отредактировал Lizard - Понедельник, 05.08.2019, 10:02
 
Ответить
Сообщениеkrosav4ig, вот этот код применительно к данному файлу:
[vba]
Код

Sub colorize()
    Dim p As Paragraph, prev&, b As Boolean
    Application.ScreenUpdating = 0
    With CreateObject("vbscript.regexp")
        .Global = False: .Pattern = "^\d+\.\d+\s"
        For Each p In ThisDocument.Paragraphs
            If .test(p.Range.Text) Then
                If prev > 0 Then
                    p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
                End If
                prev = p.Range.Start + 1
                b = Not b
            ElseIf p.Next Is Nothing Then
                p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
            End If
        Next
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Не работает.

Выдает ошибку:
Run-time error 4608: Значение лежит вне допустимого диапазона.

И подсвечивает строку:
[vba]
Код
p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
[/vba]

Автор - Lizard
Дата добавления - 05.08.2019 в 10:02
krosav4ig Дата: Понедельник, 05.08.2019, 18:53 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2148
Репутация: 893 ±
Замечаний: 0% ±

Excel 2007,2010,2013
у меня в word 2003, 2007, 2010, 2013 отрабатывает без ошибок
раскрашенные файлы прилагаю

upd.
немного переписал код
пробуйте так
[vba]
Код

Sub colorize()
          Dim p As Paragraph, prev&, b As Boolean
1         On Error GoTo colorize_Error

11        Application.ScreenUpdating = 0
21        With CreateObject("vbscript.regexp")
31            .Global = False: .Pattern = "^\d+\.\d+\s"
41            For Each p In ThisDocument.Paragraphs
51                If p.Next Is Nothing Then
61                    If .test(p.Range.Text) Then
71                        p.Range.HighlightColorIndex = IIf(b, 3, 7)
81                    ElseIf prev > 0 Then
91                        p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
101                   End If
111               ElseIf .test(p.Range.Text) Then
121                   If prev > 0 Then
131                       p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
141                   End If
151                   b = Not b
161                   prev = p.Range.Start + 1
171               End If
181           Next
191       End With
201       Application.ScreenUpdating = 1
211       On Error GoTo 0
221       Exit Sub
colorize_Error:
231       MsgBox "Error " & Err.Number & " (" & Err.Description & _
              ") in procedure colorize of VBA Document ThisDocument on line " & Erl & vbLf & _
              "paragraphs.count: " & Paragraphs.Count & ",  current paragraph: " & Range(0, _
              p.Range.End).Paragraphs.Count
End Sub
[/vba]
К сообщению приложен файл: 111-.zip(40.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 05.08.2019, 19:58
 
Ответить
Сообщениеу меня в word 2003, 2007, 2010, 2013 отрабатывает без ошибок
раскрашенные файлы прилагаю

upd.
немного переписал код
пробуйте так
[vba]
Код

Sub colorize()
          Dim p As Paragraph, prev&, b As Boolean
1         On Error GoTo colorize_Error

11        Application.ScreenUpdating = 0
21        With CreateObject("vbscript.regexp")
31            .Global = False: .Pattern = "^\d+\.\d+\s"
41            For Each p In ThisDocument.Paragraphs
51                If p.Next Is Nothing Then
61                    If .test(p.Range.Text) Then
71                        p.Range.HighlightColorIndex = IIf(b, 3, 7)
81                    ElseIf prev > 0 Then
91                        p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
101                   End If
111               ElseIf .test(p.Range.Text) Then
121                   If prev > 0 Then
131                       p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
141                   End If
151                   b = Not b
161                   prev = p.Range.Start + 1
171               End If
181           Next
191       End With
201       Application.ScreenUpdating = 1
211       On Error GoTo 0
221       Exit Sub
colorize_Error:
231       MsgBox "Error " & Err.Number & " (" & Err.Description & _
              ") in procedure colorize of VBA Document ThisDocument on line " & Erl & vbLf & _
              "paragraphs.count: " & Paragraphs.Count & ",  current paragraph: " & Range(0, _
              p.Range.End).Paragraphs.Count
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 05.08.2019 в 18:53
Lizard Дата: Понедельник, 05.08.2019, 22:11 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 56
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, теперь у меня тоже заработало.
Спасибо за помощь.
 
Ответить
Сообщениеkrosav4ig, теперь у меня тоже заработало.
Спасибо за помощь.

Автор - Lizard
Дата добавления - 05.08.2019 в 22:11
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Закраска разделов документа word, с учетом текста строки
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!