1 Тема от Natick_K

  • Natick_K
  • рядовой
  • Неактивен
  • Зарегистрирован: 04.01.2017
  • Сообщений: 2

Тема: Макрос форматирования всех таблиц в документе

Добрый день! Помогите, пожалуйста, создать макрос для форматирования всех таблиц в документе.
Нужно, чтобы они размещались по ширине страницы и имели такие же параметры, как текст: верхнее и нижнее поле - 2 см, левое 3 см, правое 1,5 см.
Есть такой макрос, который задает нужные параметры всем таблицам, а именно: шрифт Times New Roman, 10, междустрочный интервал 1.5, выравнивание таблицы и текста в ней по ширине. А вот как дописать, чтобы у таблицы были параметры полей, как у текста не знаю. Помогите, пожалуйста.


Sub т1()
'
' т1 Макрос
'
'
2 Dim oTable As Table
3 For Each oTable In ActiveDocument.Tables
4 oTable.Select
5 Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
6 With Selection.Tables(1).Borders
7 .InsideLineStyle = wdLineStyleSingle
8 .InsideLineWidth = wdLineWidth050pt
9 .InsideColor = wdColorAutomatic
10 .InsideLineStyle = wdLineStyleSingle
11 .OutsideLineWidth = wdLineWidth050pt
12 .OutsideColor = wdColorAutomatic
13 End With
14 With Selection.ParagraphFormat
15 .LeftIndent = CentimetersToPoints(0)
16 .RightIndent = CentimetersToPoints(0)
17 .SpaceBefore = 0
18 .SpaceBeforeAuto = False
19 .SpaceAfter = 0
20 .SpaceAfterAuto = False
21 .LineSpacingRule = wdLineSpace1pt5
22 .Alignment = wdAlignParagraphJustify
23 .WidowControl = True
24 .KeepWithNext = False
25 .KeepTogether = False
26 .PageBreakBefore = False
27 .NoLineNumber = False
28 .Hyphenation = True
29 .FirstLineIndent = CentimetersToPoints(0)
30 End With
31 With Selection.Font
32 .Name = "Times New Roman"
33 .Size = 10
34 .Bold = False
35 .Italic = False
36 .Underline = wdUnderlineNone
37 .UnderlineColor = wdColorAutomatic
38 .StrikeThrough = False
39 .DoubleStrikeThrough = False
40 .Outline = False
41 .Emboss = False
42 .Shadow = False
43 .Hidden = False
44 .SmallCaps = False
45 .AllCaps = False
46 .Color = wdColorAutomatic
47 .Engrave = False
48 .Superscript = False
49 .Subscript = False
50 .Spacing = 0
51 .Scaling = 100
52 .Position = 0
53 .Kerning = 0
54 .Animation = wdAnimationNone
55 End With
56 Next
57 End Sub

2 Ответ от Fck_This

  • Макрос форматирования всех таблиц в документе
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97
  • За сообщение: 1

Re: Макрос форматирования всех таблиц в документе

Natick_K пишет:

Добрый день! Помогите, пожалуйста, создать макрос для форматирования всех таблиц в документе.
Нужно, чтобы они размещались по ширине страницы и имели такие же параметры, как текст: верхнее и нижнее поле - 2 см, левое 3 см, правое 1,5 см.
Есть такой макрос, который задает нужные параметры всем таблицам, а именно: шрифт Times New Roman, 10, междустрочный интервал 1.5, выравнивание таблицы и текста в ней по ширине. А вот как дописать, чтобы у таблицы были параметры полей, как у текста не знаю. Помогите, пожалуйста.


Sub т1()
'
' т1 Макрос
'
'
2 Dim oTable As Table
3 For Each oTable In ActiveDocument.Tables
4 oTable.Select
5 Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
6 With Selection.Tables(1).Borders
7 .InsideLineStyle = wdLineStyleSingle
8 .InsideLineWidth = wdLineWidth050pt
9 .InsideColor = wdColorAutomatic
10 .InsideLineStyle = wdLineStyleSingle
11 .OutsideLineWidth = wdLineWidth050pt
12 .OutsideColor = wdColorAutomatic
13 End With
14 With Selection.ParagraphFormat
15 .LeftIndent = CentimetersToPoints(0)
16 .RightIndent = CentimetersToPoints(0)
17 .SpaceBefore = 0
18 .SpaceBeforeAuto = False
19 .SpaceAfter = 0
20 .SpaceAfterAuto = False
21 .LineSpacingRule = wdLineSpace1pt5
22 .Alignment = wdAlignParagraphJustify
23 .WidowControl = True
24 .KeepWithNext = False
25 .KeepTogether = False
26 .PageBreakBefore = False
27 .NoLineNumber = False
28 .Hyphenation = True
29 .FirstLineIndent = CentimetersToPoints(0)
30 End With
31 With Selection.Font
32 .Name = "Times New Roman"
33 .Size = 10
34 .Bold = False
35 .Italic = False
36 .Underline = wdUnderlineNone
37 .UnderlineColor = wdColorAutomatic
38 .StrikeThrough = False
39 .DoubleStrikeThrough = False
40 .Outline = False
41 .Emboss = False
42 .Shadow = False
43 .Hidden = False
44 .SmallCaps = False
45 .AllCaps = False
46 .Color = wdColorAutomatic
47 .Engrave = False
48 .Superscript = False
49 .Subscript = False
50 .Spacing = 0
51 .Scaling = 100
52 .Position = 0
53 .Kerning = 0
54 .Animation = wdAnimationNone
55 End With
56 Next
57 End Sub

Для изменения левого и правого отступа использовать нужно будет такой код, но как и с вертикальным выравниванием - не понятно относительно чего. Это: слева до рамки 2см и ещё + 1 от рамки, справа - 1.5 см от рамки (это при условии, что у вас стоит стандартная ширина листа А4 в 21 см).
    

oTable.Rows.LeftIndent = CentimetersToPoints(1)
    oTable.PreferredWidthType = wdPreferredWidthPoints
    oTable.PreferredWidth = CentimetersToPoints(16.5)

Вставить его нужно где-нибудь между строками "For each oTable in activedocument.tables" и "Next".
А по поводу отступов сверху и снизу - не понял. Относительно чего у вас отступы должны быть? относительно края листа (у меня отступ 2 см стандартно, можно настраивать в параметрах страницы) или относительно текста? А если ячеек мало, они должны растягиваться до конца листа? Уточняйте пожалуйста.

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

3 Ответ от Natick_K

  • Natick_K
  • рядовой
  • Неактивен
  • Зарегистрирован: 04.01.2017
  • Сообщений: 2

Re: Макрос форматирования всех таблиц в документе

Спасибо большое! буду пробовать!