1

Тема: Макрос по форматированию таблиц

Здравствуйте, с наступающим НГ! Помогите пожалуйста.
Имеется текст с большим колическтво таблиц, нужен макрос, который бы вставлял название всем табличкам в зависимости от раздела, например ТАБЛИЦА 1.1... ТАБЛИЦА 2.1 и т.д перед самими табличками.

и еще вопрос по форматированию, вообще реально написать код, который находил бы "разбитые" страницами таблицы, т.е часть строк таблицы на одном листе, а часть на другом, и на второй таблицы добавлял бы новую строку с цифрами 1,2,3 и т.д и в иделе вставлял бы продолжение таблицы 1.1 (см схему=))).

                                         таблица 1.1
sadfkjsadf | sdfsdf | sdfsdfsdf | sdfsdf |
sadfkjsadf | sdfsdf | sdfsdfsdf | sdfsdf |
______________________________

                  продолжение таблицы 1.1
         1      |      2    |      3        |     4    |
sadfkjsadf | sdfsdf | sdfsdfsdf | sdfsdf |

благодарен любым советам, замечаниям, пожеланиям. smile

2

Re: Макрос по форматированию таблиц

darklumen, приложите ваш документ.

3

Re: Макрос по форматированию таблиц

прикрепил архив - там 2 файла. в одном - исх текст - во втором как должно получиться. smile

4

Re: Макрос по форматированию таблиц

Я вижу ваш документ и понимаю, что для того, чтобы сделать то, как вы просите, нужно как минимум создать подходящие стили для заголовков (для ваших разделов).
Во-вторых, чтобы не мучится вот с таким ручным вводом надтабличных надписей, следует автоматизировать их вставку. И создать стили, опять же, для надписей.
В-третьих, о надписи "Продолжение таблицы". У вас это не продолжение, а новая таблица в новом разделе. На сайте уже поднимался вопрос неоднократно о такой надписи - ГОСТом она не предусмотрена (хотя в Учебных заведениях продолжают этой ерундой заниматься).
Посмотрите в комментариях к упомянутой заметке, как люди выходят из положения.

В вашем случае (для надтабличной надписи) я бы создал стили для заголовков, оформил бы имеющиеся нумерованные заголовки этими стилями, установил бы автоназвания для рисунков и таблиц (меню Вставка - Ссылка - Название), написал бы макрос для всех таблиц, вырезающих их и вставляющих заново. При этом автоматом бы проставились надтабличные надписи. И вручную бы прошелся по документу, где надо оформляя текст и эти надписи стилями.
Да, придется поработать, согласен.

5

Re: Макрос по форматированию таблиц

что-то понял, что-то нет! но все равно спасибо! smile

6

Re: Макрос по форматированию таблиц

Спрашивайте, что непонятно в моем ответе.
Кстати, вы можете почитать заметки на вашу тему:
Как автоматически вставить подпись к рисунку или таблице

7

Re: Макрос по форматированию таблиц

ну теперь у меня новая проблема. у меня создан свой собственный стиль для заголовков. когда я пытаюсь вставить название таблицы типа ТАБЛИЦА 1.1, word привязывает название к нумерованному стилю типа СТИЛЬ1, СТИЛЬ2 и т.д.

в итоге ошибка: Таблица Ошибка! Текст указанного стиля в документе отсутствует..1

у меня мой стиль называется не ЗАГОЛОВОК 1, а "Мой стиль"

нашел в настройках - вопрос снимается! smile)))

Отредактировано darklumen (23.12.2009 23:38:20)

8

Re: Макрос по форматированию таблиц

Я бы вам еще рекомендовал защищать стили от изменений. Тогда можно будет не боятся, что стили вашего документа "поедут", например, при вставке скопированного из других документов текста.

9

Re: Макрос по форматированию таблиц

Admin пишет:

Я бы вам еще рекомендовал защищать стили от изменений. Тогда можно будет не боятся, что стили вашего документа "поедут", например, при вставке скопированного из других документов текста.

а как это сделать?

и еще возвращаясь к названию таблиц: где изменить поле я нашел (ПКМ - изменить поле), а вот когда макрос записываю, то правая кнопка не работает, и не могу изменить поле. это както можно сделать через код?

10

Re: Макрос по форматированию таблиц

Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 23.12.2009 DarkLumen
'
    With CaptionLabels("Таблица")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorPeriod
    End With
    Selection.InsertCaption Label:="Таблица", TitleAutoText:="InsertCaption1", _
         Title:="", Position:=wdCaptionPositionAbove
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
End Sub

11

Re: Макрос по форматированию таблиц

Sub Ìàêðîñ1()

Dim myTable As Table
For Each myTable In ActiveDocument.Tables
    Selection.InsertCaption Label:="таблица", TitleAutoText:="InsertCaption1", _
        Title:="", Position:=wdCaptionPositionAbove

    Selection.MoveLeft Unit:=wdCharacter, Count:=3
    WordBasic.FormatField Field:="STYLEREF  \s мой стиль "
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    
    Next myTable
End Sub

убейте меня, я уже не соображаю. sad
что в этом макросе не так??? создание заголовков для таблиц в документе. yikes  neutral
я понимаю что достал уже, просто не хочет работать нормально. smile)))

Отредактировано darklumen (24.12.2009 01:28:13)

12

Re: Макрос по форматированию таблиц

darklumen пишет:

а как это сделать?

Чтобы защитить документ, в меню Сервис выберите команду "Защитить документ". Откроется область задач Защита документа. Установите флажок на параметре "Ограничить набор разрешенных стилей" (дополнительно можно выбрать нужные стили в окне, открываемом по нажатию кнопки "Настройка"), а затем нажмите кнопку "Да, включить защиту". Откажитесь от установки пароля (если вы работате один и не передаете шаблон другим людям).

13

Re: Макрос по форматированию таблиц

darklumen пишет:

убейте меня, я уже не соображаю. sad
что в этом макросе не так??? создание заголовков для таблиц в документе. yikes  neutral
я понимаю что достал уже, просто не хочет работать нормально. smile)))

Попробуйте так:

Sub insTblCaptions
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
    With CaptionLabels(wdCaptionTable)
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorPeriod
    End With
   tbl.Range.InsertCaption Label:=wdCaptionTable, TitleAutoText:="InsertCaption1", _
         Title:="", Position:=wdCaptionPositionAbove
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Next tbl
End Sub

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

14

Re: Макрос по форматированию таблиц

Попробуйте такой макрос. Я усовершествовал сделанный вами макрос:

Sub InsertTableCaption()
  Dim oTbl As Table
  Dim oRng As Range
  
  For Each oTbl In ActiveDocument.Tables
    'Вставляем название
    oTbl.Range.InsertCaption "Таблица", , , wdCaptionPositionAbove
    'Запоиминаем положение слова "Таблица"
    Set oRng = oTbl.Range.Paragraphs.First.Previous.Range.Words.First
    'Переносим диапазон в конец этого слова
    oRng.Collapse wdCollapseEnd
    'Вставляем поле StyleRef
    With ActiveDocument.Fields.Add(oRng, wdFieldStyleRef, "Стиль1 \n")
      'После поля вставляем точку
      .Result.InsertAfter "."
    End With
  Next
End Sub

Ключа \s у поля STYLEREF нет. Выравнивать название таблицы нужно не вручную, а изменяя стиль «Название объекта»

Лучше день потерять — потом за пять минут долететь!

15

Re: Макрос по форматированию таблиц

admin пишет:
darklumen пишет:

убейте меня, я уже не соображаю. sad
что в этом макросе не так??? создание заголовков для таблиц в документе. yikes  neutral
я понимаю что достал уже, просто не хочет работать нормально. smile)))

Попробуйте так:

Sub insTblCaptions
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
    With CaptionLabels(wdCaptionTable)
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorPeriod
    End With
   tbl.Range.InsertCaption Label:=wdCaptionTable, TitleAutoText:="InsertCaption1", _
         Title:="", Position:=wdCaptionPositionAbove
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Next tbl
End Sub

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

все нормально работает только опять выдает " Таблица Ошибка! Текст указанного стиля в документе отсутствует..3" и вторая цифра идет сквозная, а не по количеству таблиц в разделе.

16

Re: Макрос по форматированию таблиц

По моему мнению, это происходит, так как у вас названия глав не оформлены как заголовки. Я вам рекомендую не создавать для таких элементов свой стиль, а редактировать имеющийся, так как по сути это и есть заголовки соответствующих разделов документа. Да, и закройте стили от изменения, чтобы не поехали они.
Только что попробовал - все получается корректно и с первой цифрой и со второй по порядку таблиц.

17

Re: Макрос по форматированию таблиц

спасибо!т ак и сдалею! +)))

18

Re: Макрос по форматированию таблиц

надеюсь последний вопрос по этой тему: а вот если в тексте у каких-то таблиц уже есть заголовки, а у каких-то нет, можно дописать условие при котором если есть заголовок - то его просто обновляем, а ели нет- то вставляем! smile

19

Re: Макрос по форматированию таблиц

Можно. проверяя каким стилем оформлен абзац перед таблицей:

oTbl.Range.Paragraphs.First.Previous.Style
Лучше день потерять — потом за пять минут долететь!

20

Re: Макрос по форматированию таблиц

viter.alex пишет:

Можно. проверяя каким стилем оформлен абзац перед таблицей:

oTbl.Range.Paragraphs.First.Previous.Style

не очень понятно, объясните пожалуйста smile

21

Re: Макрос по форматированию таблиц

У нас есть цикл, который проходит по всем таблицам и ставит к ним название. Если название уже стоит, то абзац перед таблицей будет оформлен стилем «Название объекта», логично?
Далее, как получить стиль этого абзаца? Тем выражением, которое я написал. oTbl это условная переменная, по которой идёт перебор таблиц в цикле. У Антона она называется tbl, у меня oTbl, но это неважно. Из этой таблицы мы выбираем все абзацы (oTbl.Range.Paragraphs), из абзацев выбираем первый (oTbl.Range.Paragraphs.First), затем берём предыдущий абзац по отношению к первому(oTbl.Range.Paragraphs.First.Previous) и определяем его стиль. Вот и всё.

If oTbl.Range.Paragraphs.First.Previous.Style <> "Название объекта" Then
…
End If
Лучше день потерять — потом за пять минут долететь!