Форум программистов, компьютерный форум, киберфорум
Наши страницы
MS Office Word
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.70/43: Рейтинг темы: голосов - 43, средняя оценка - 4.70
Slamzor
360 / 37 / 2
Регистрация: 16.03.2013
Сообщений: 186
1

Макрос для форматирования текста

24.05.2013, 11:59. Просмотров 8200. Ответов 12
Метки нет (Все метки)

Приветствую!
Необходимо в документе (во всех местах, учитывая верхний и нижний колонтитулы - по возможности) ко всему тексту применить следующее:
1. Убрать выделение цветом текста.
2. Удалить зачеркнутый (зачеркнутый дважды) текст.
3. Цвет текста сделать авто (черным).
Прилагаемый пример:
0
Вложения
Тип файла: docx Форматирование текста.docx (28.2 Кб, 94 просмотров)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
24.05.2013, 11:59
Ответы с готовыми решениями:

Необходимо создать макрос для форматирования текста
Sub nech() Dim Par As Paragraph parCount = ActiveDocument.Paragraphs.Count ...

Макрос с повтором заданного форматирования таблицы
С помощью макрорекордера создал макрос форматирования таблицы вот код: Sub Tablica() ' '...

Макрос для поиска и вставки текста
Друзья, помогите, пожалуйста, с простенькой задачкой. Пусть, помимо прочего текста, в документе...

Нужен макрос для поиска полужирного текста
Добрый день. Нужен макрос для поиска полужирного текста в документе и копирования результатов в...

Нужен макрос для Word по изменению языка текста
Помогите, пожалуйста, создать макрос или найти способ решения данной проблемы: Часто работаю с...

12
Sasha_Smirnov
5494 / 1322 / 144
Регистрация: 08.02.2009
Сообщений: 4,042
Записей в блоге: 29
25.05.2013, 04:59 2
Docx открыть не могу, но пп. 1 и 3 так: выделить и нажать Ctrl-пробел.
0
Slamzor
360 / 37 / 2
Регистрация: 16.03.2013
Сообщений: 186
26.05.2013, 17:13  [ТС] 3
Sasha_Smirnov,
1. Хмм, у меня открывает. Залью Doc.
2. Про Cntrl+space ... происходит следующее: шрифт 12 и по центру.
0
Вложения
Тип файла: doc Форматирование текста(Doc).doc (49.0 Кб, 33 просмотров)
shanemac51
Модератор
Эксперт MS Access
9078 / 3473 / 551
Регистрация: 07.08.2010
Сообщений: 9,721
Записей в блоге: 2
27.05.2013, 01:10 4
Лучший ответ Сообщение было отмечено как решение

Решение

для основного текста
в коллонтитулах не сработает(в придачу там еще и раскраска таблицы)
Код
Sub w130525()
'

'
 Selection.WholeStory
 Selection.Shading.Texture = wdTextureNone
 Selection.Shading.ForegroundPatternColor = wdColorAutomatic
 Selection.Shading.BackgroundPatternColor = wdColorAutomatic
 Selection.Font.Color = wdColorAutomatic
 With Selection.Font
  .Borders(1).LineStyle = wdLineStyleNone
  .Borders.Shadow = False
 End With
 With Options
  .DefaultBorderLineStyle = wdLineStyleSingle
  .DefaultBorderLineWidth = wdLineWidth050pt
  .DefaultBorderColor = wdColorAutomatic
 End With
 With Selection.ParagraphFormat
  .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
  .Borders(wdBorderRight).LineStyle = wdLineStyleNone
  .Borders(wdBorderTop).LineStyle = wdLineStyleNone
  .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
  .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
  With .Borders
   .DistanceFromTop = 1
   .DistanceFromLeft = 4
   .DistanceFromBottom = 1
   .DistanceFromRight = 4
   .Shadow = False
  End With
 End With
 With Options
  .DefaultBorderLineStyle = wdLineStyleSingle
  .DefaultBorderLineWidth = wdLineWidth050pt
  .DefaultBorderColor = wdColorAutomatic
 End With
 With Selection.Font.Shading
  .Texture = wdTextureNone
  .ForegroundPatternColor = wdColorAutomatic
  .BackgroundPatternColor = wdColorAutomatic
 End With
 With Options
  .DefaultBorderLineStyle = wdLineStyleSingle
  .DefaultBorderLineWidth = wdLineWidth050pt
  .DefaultBorderColor = wdColorAutomatic
 End With
 Options.DefaultHighlightColorIndex = wdNoHighlight
 Selection.Range.HighlightColorIndex = wdNoHighlight
''''''''''''''''''''''''''''''''
Dim pr As Paragraph
Dim j1
j1 = Word.ActiveDocument.Paragraphs.Count
Do While j1 > 1
j1 = j1 - 1

Word.ActiveDocument.Paragraphs(j1).Range.Select
If Selection.Font.DoubleStrikeThrough = True Then
Debug.Print j1, Selection.Range.Text;

  Word.ActiveDocument.Paragraphs(j1).Range.Delete
End If

Loop
End Sub
0
27.05.2013, 01:10
Slamzor
360 / 37 / 2
Регистрация: 16.03.2013
Сообщений: 186
27.05.2013, 08:45  [ТС] 5
shanemac51, Спасибо, но в ходе применения весь текст обрамляется в рамки, а также текст с зачеркиванием не удаляется.
Вот результат на другом примере:
0
Вложения
Тип файла: docx Пример.docx (50.0 Кб, 20 просмотров)
shanemac51
Модератор
Эксперт MS Access
9078 / 3473 / 551
Регистрация: 07.08.2010
Сообщений: 9,721
Записей в блоге: 2
27.05.2013, 10:09 6
я удаляла двойное зачеркивание
одинарное оставляла

может так подойдет
Код
Sub w130525a()

 Selection.WholeStory
 Selection.Shading.Texture = wdTextureNone
 Selection.Shading.ForegroundPatternColor = wdColorAutomatic
 Selection.Shading.BackgroundPatternColor = wdColorAutomatic
 Selection.Font.Color = wdColorAutomatic
 
 With Options
  .DefaultBorderColor = wdColorAutomatic
 End With
 With Selection.ParagraphFormat
  .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
  .Borders(wdBorderRight).LineStyle = wdLineStyleNone
  .Borders(wdBorderTop).LineStyle = wdLineStyleNone
  .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
  .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
 End With
 With Options
  .DefaultBorderColor = wdColorAutomatic
 End With
 With Selection.Font.Shading
  .Texture = wdTextureNone
  .ForegroundPatternColor = wdColorAutomatic
  .BackgroundPatternColor = wdColorAutomatic
 End With
 With Options
  .DefaultBorderColor = wdColorAutomatic
 End With
 Options.DefaultHighlightColorIndex = wdNoHighlight
 Selection.Range.HighlightColorIndex = wdNoHighlight
''''''''''''''''''''''''''''''''
Dim pr As Paragraph
Dim j1
j1 = Word.ActiveDocument.Paragraphs.Count
Do While j1 > 1
j1 = j1 - 1

Word.ActiveDocument.Paragraphs(j1).Range.Select
If Selection.Font.DoubleStrikeThrough = True Then
Debug.Print j1, Selection.Range.Text;
Word.ActiveDocument.Paragraphs(j1).Range.Delete
End If
If Selection.Font.StrikeThrough = True Then
Debug.Print j1, Selection.Range.Text;
Word.ActiveDocument.Paragraphs(j1).Range.Delete
End If

Loop
End Sub
1
Slamzor
360 / 37 / 2
Регистрация: 16.03.2013
Сообщений: 186
27.05.2013, 11:47  [ТС] 7
shanemac51, Двойное зачеркивание не всегда удаляет и видоизменяет шапку таблицы...
Я решил поэксперементировать с поиском и заменой, с помощью подст. знаков.
Думаю, что можно, сделать четыре макроса (или три), затем их объеденить в один.
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub Удаление_двойного_зачеркивания()
'
' Удаление_двойного_зачеркивания Макрос
'
'
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Underline = wdUnderlineNone
        .StrikeThrough = False
        .DoubleStrikeThrough = True
        .Color = wdColorAutomatic
        .Superscript = False
        .Subscript = False
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Underline = wdUnderlineNone
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Superscript = False
        .Subscript = False
    End With
    With Selection.Find
        .Text = "*"
        .Replacement.Text = " "         ' - как бы вместо этого удаление соорудить? У _
меня тут пробел,  если не трогать, то просто снимается двойное зачеркивание
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub


Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Красный_цвет_в_черный()
'
' Красный_цвет_в_черный Макрос
' форматирует красный цвет в черный
'
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Underline = wdUnderlineNone
        .Color = wdColorRed  ' Можно ли здесь указать любой цвет ? Пытался процедуру _
 записать по другому: Выделить все CNTRL+A и цвет выставить авто(черный) _
но при использовании только выделяет весь текст. 
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Underline = wdUnderlineNone
        .Color = wdColorAutomatic
    End With
    With Selection.Find
        .Text = "*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Появились некоторые вопросы, посмотрите в коде макрорекодера.
Или моя идея вообще в корне не правильна ?
0
Скрипт
5452 / 1133 / 49
Регистрация: 15.09.2012
Сообщений: 3,429
27.05.2013, 12:31 8
Slamzor, вот так можно узнавать номер цвета:
  1. поставьте в Word-документе курсор на текст, который имеет нужный цвет;
  2. запустите этот макрос:
    Макрос
    Visual Basic
    1
    2
    3
    4
    5
    6
    
    Sub Procedure_1()
        
        'Вывод результата в View - Immediate Window.
        Debug.Print Selection.Font.Color
     
    End Sub
0
Slamzor
360 / 37 / 2
Регистрация: 16.03.2013
Сообщений: 186
27.05.2013, 12:40  [ТС] 9
Скрипт, а можно чтобы не узнавать? Мне любой цвет в черный красить. Есть такая команда, любой цвет? Или без того чтобы не определять не получится?
0
Скрипт
5452 / 1133 / 49
Регистрация: 15.09.2012
Сообщений: 3,429
27.05.2013, 12:44 10
Лучший ответ Сообщение было отмечено как решение

Решение

Slamzor, а такое не работает?
Visual Basic
1
2
3
4
5
Sub Procedure_2()
 
    ActiveDocument.Range.Font.ColorIndex = wdAuto
 
End Sub
1
shanemac51
Модератор
Эксперт MS Access
9078 / 3473 / 551
Регистрация: 07.08.2010
Сообщений: 9,721
Записей в блоге: 2
27.05.2013, 12:53 11
Код
Sub UD_зачеркив()        '' хоть слова, хоть символа

 Selection.Find.ClearFormatting
 With Selection.Find.Font
  .StrikeThrough = True
  .DoubleStrikeThrough = False
 End With
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
End Sub
Sub COLOR_RED_A()         'красный в авто
'

'
 Selection.Find.ClearFormatting
 Selection.Find.Font.Color = wdColorRed
 Selection.Find.Replacement.ClearFormatting
 Selection.Find.Replacement.Font.Color = wdColorAutomatic
 With Selection.Find
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 End Sub
 Sub COLOR_a()          'все в авто
 
 Selection.WholeStory
 Selection.Font.Color = wdColorAutomatic
End Sub
1
Slamzor
360 / 37 / 2
Регистрация: 16.03.2013
Сообщений: 186
27.05.2013, 13:29  [ТС] 12
Скрипт, отлично работает, как бы теперь зачеркнутый удалить?

Добавлено через 15 минут
Получилось три кнопки. Нельзя теперь все три макроса объеденить в один ?
0
Скрипт
5452 / 1133 / 49
Регистрация: 15.09.2012
Сообщений: 3,429
27.05.2013, 13:34 13
Цитата Сообщение от Slamzor Посмотреть сообщение
Получилось три кнопки. Нельзя теперь все три макроса объеденить в один ?
Код
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Main()
 
    Call Procedure_1
    Call Procedure_2
    Call Procedure_3
 
End Sub
 
Sub Procedure_1()
 
End Sub
 
Sub Procedure_2()
 
End Sub
 
Sub Procedure_3()
 
End Sub
0
27.05.2013, 13:34
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
27.05.2013, 13:34

Макрос для перемены двух последовательно выделенных букв текста
макрос для перемены двух последовательно выделенных букв текста

Потеря форматирования текста при копировании фрагмента отдельных страниц из браузера в Word 2010
Word 2010 Firefox 54.0.1 (32-бит) Копирую фрагмент из браузера, содержащий форматированный текст,...

Макрос на удаление текста
Здравствуйте дорогие форумчане, и так каждый раз форматировал текст вручную, потом дошло что можно...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
13
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.