1

Тема: Форматирование таблиц

Добрый день
По работе часто форматриую всяческие таблицы. При этом - основное требование:
для отрицательных (они оторбажаются в скобках) - отступ справа 0
для положительных - 0.1
Возможно ли процесс форматирования автоматизировать с помощью макроса?
Спасибо

2

Re: Форматирование таблиц

Форматирование таблицы (выравнивание, границы и т.п.) с помощью макроса возможно. Нужно лишь знать, что именно, какие параметры вы хотите задать.
Что это за требование, о котором вы упоминаете? Что за

для отрицательных (они оторбажаются в скобках) - отступ справа 0
для положительных - 0.1

О чем это вы, уточните.

3

Re: Форматирование таблиц

В таблице есть как отрицательные, так и положительные цифры (отрицательные в скобкак - бухгалтерский формат)
Положительные цифры должны быть отформатированы (indentation rigth 0.1), Отрицательные (indentation right 0).
Я приложил небольшой примерчик. И мне интересно, можно ли написать такой макрос, который определяет положительное чилсло или отрицательное и применяет нужное форматирование.

Post's attachments

sample.doc 29.5 Кб, 3 скачиваний с 2010-03-24 

You don't have the permssions to download the attachments of this post.

4

Re: Форматирование таблиц

Вот так, что ли?

Sub FormatCell()
  Dim oCell As Cell
  Dim sCellText As String
  For Each oCell In Selection.Tables(1).Range.Cells
    sCellText = Replace(oCell.Range.Text, "(", "")
    sCellText = Replace(sCellText, ")", "")
    sCellText = Replace(sCellText, ChrW(13) & ChrW(7), "")
    If IsNumeric(sCellText) Then
      If Val(sCellText) > 0 Then
        oCell.Range.ParagraphFormat.RightIndent = CentimetersToPoints(0.1)
      Else
        oCell.Range.ParagraphFormat.RightIndent = CentimetersToPoints(0)
      End If
    End If
  Next
End Sub

Сообщение не увидел перед этим. Думаю, что макрос подойдёт

Added
Посмотрел. Не подойдёт, хотя не сложно переделать Я так понимаю, что нужно выровнять запятые? Чтобы разряды были строго друг под другом? Это делается при помощи табуляции по разделителю, а не отступами

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

5

Re: Форматирование таблиц

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

add. Именно отступами

Отредактировано smokky (24.03.2010 12:01:35)

6

Re: Форматирование таблиц

Тогда так. Если ячейки выделены в разных местах таблицы, то форматируются только последние. Если выделение спложное, то форматируются все.

Sub FormatCell2()
  Dim oCell As Cell
  Dim sCellText As String
  Dim IsPositive As Boolean
  For Each oCell In Selection.Cells
    sCellText = oCell.Range.Text
    IsPositive = InStr(sCellText, "(") = 0
    sCellText = Replace(oCell.Range.Text, "(", "")
    sCellText = Replace(sCellText, ")", "")
    sCellText = Replace(sCellText, ChrW(13) & ChrW(7), "")
    If IsPositive Then
      oCell.Range.ParagraphFormat.RightIndent = CentimetersToPoints(0.1)
    Else
      oCell.Range.ParagraphFormat.RightIndent = CentimetersToPoints(0)
    End If
  Next
End Sub

Но, повторюсь, нужно выравнивать с помощью табуляции по разделителю.

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

7

Re: Форматирование таблиц

По форматированию, к сожалению, такие требования(
За макрос - спасибо огромное. Все работате просто супер big_smile

8

Re: Форматирование таблиц

Пожалуйста, но я всё-таки предложу вариант и с табуляцией. Только для одного выделенного столбца:

Sub FormatCell2()
  Dim oCell As Cell
  Dim CellRng As Range
  Dim sCellText As String
  Dim IsPositive As Boolean
  If Selection.Cells.Count = 0 Then Exit Sub
  Set CellRng = Selection.Cells(1).Range
  'Сжимаем диапазон до запятой
  CellRng.MoveStartUntil ","
  CellRng.MoveEndUntil ",", wdBackward
  'Добавляем табуляцию по разделителю
  Selection.ParagraphFormat.TabStops.ClearAll
  Selection.ParagraphFormat.TabStops.Add CellRng.Information(wdHorizontalPositionRelativeToTextBoundary), wdAlignTabDecimal, wdTabLeaderSpaces
  'Выравнивание абзаца по ширине
  Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Sub
Лучше день потерять — потом за пять минут долететь!

9

Re: Форматирование таблиц

Привет.
Если применить для произвольной таблицы команду "Автоподбор по ширине окна", Word автоматически  подгонит таблицу по ширине окна, но мне нужно подогнать таблицу по границе текста, тоже автоматически и желательно для всех таблиц в документе.
Форматирование таблиц
Спасибо  smile

Отредактировано 1st (04.04.2010 15:30:23)

10

Re: Форматирование таблиц

Т.е. вы хотите сказать, что таблица сверху выровнена по ширине окна, а таблица снизу по ширине текста? Это не так. Во второй таблице левая граница текста в ячейке совпадает левой границей страницы, а правая граница текста в ячейке — с правой границей страницы.
Собственно, чего вы хотите добиться?

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

11

Re: Форматирование таблиц

Мне нужно чтобы края таблицы совпадал с границами текста, как "Таблица 2"
Форматирование таблиц
В документе очень много таблиц и все они вида "Таблица 1". Трудоемко каждую таблицу подтягивать к границам текста.
Спасибо

Отредактировано 1st (04.04.2010 22:23:55)

12

Re: Форматирование таблиц

Sub AllHeadersTablesWidth()
Dim hRange As Range ' диапазон верхних колонтитулов
Dim ehRange As Range ' диапазон верхних четных колонтитулов
Dim fhRange As Range ' диапазон верхних колонтитулов первых страниц
Dim fRange As Range ' диапазон нижних колонтитулов
Dim efRange As Range ' диапазон нижних четных колонтитулов
Dim ffRange As Range ' диапазон нижних колонтитулов первых страниц
Dim tbl As Table
Dim sec As Section
Dim PageWidth As Single ' Ширина страниц
Dim LeftMargin As Single 'Отступ текста от левого края страницы
Dim RightMargin As Single ' Отступ текста от правого края страницы
Dim TableWidth As Single
Dim CurrentDoc As Document
Set CurrentDoc = ActiveDocument ' присвоение переменной имени текущего документа
Dim i As Integer
i = 1
For Each sec In ActiveDocument.Sections
        PageWidth = CurrentDoc.Sections(i).PageSetup.PageWidth
        LeftMargin = CurrentDoc.Sections(i).PageSetup.LeftMargin
        RightMargin = CurrentDoc.Sections(i).PageSetup.RightMargin
        TableWidth = PageWidth - (LeftMargin + RightMargin)
    Set hRange = sec.Headers(wdHeaderFooterPrimary).Range
    Set ehRange = sec.Headers(wdHeaderFooterEvenPages).Range
    Set fhRange = sec.Headers(wdHeaderFooterFirstPage).Range
    Set fRange = sec.Footers(wdHeaderFooterPrimary).Range
    Set efRange = sec.Footers(wdHeaderFooterEvenPages).Range
    Set ffRange = sec.Footers(wdHeaderFooterFirstPage).Range

    For Each tbl In fhRange.Tables
        tbl.Rows.Alignment = wdAlignRowCenter
        tbl.Rows.LeftIndent = CentimetersToPoints(0)
        tbl.PreferredWidthType = wdPreferredWidthPoints
        tbl.PreferredWidth = TableWidth
        Application.ScreenRefresh
    Next tbl
    For Each tbl In ffRange.Tables
        tbl.Rows.Alignment = wdAlignRowCenter
        tbl.Rows.LeftIndent = CentimetersToPoints(0)
        tbl.PreferredWidthType = wdPreferredWidthPoints
        tbl.PreferredWidth = TableWidth
        Application.ScreenRefresh
    Next tbl
    For Each tbl In hRange.Tables
        tbl.Rows.Alignment = wdAlignRowCenter
        tbl.Rows.LeftIndent = CentimetersToPoints(0)
        tbl.PreferredWidthType = wdPreferredWidthPoints
        tbl.PreferredWidth = TableWidth
        Application.ScreenRefresh
    Next tbl
    For Each tbl In fRange.Tables
        tbl.Rows.Alignment = wdAlignRowCenter
        tbl.Rows.LeftIndent = CentimetersToPoints(0)
        tbl.PreferredWidthType = wdPreferredWidthPoints
        tbl.PreferredWidth = TableWidth
        Application.ScreenRefresh
    Next tbl
    For Each tbl In ehRange.Tables
        tbl.Rows.Alignment = wdAlignRowCenter
        tbl.Rows.LeftIndent = CentimetersToPoints(0)
        tbl.PreferredWidthType = wdPreferredWidthPoints
        tbl.PreferredWidth = TableWidth
        Application.ScreenRefresh
    Next tbl
    For Each tbl In efRange.Tables
        tbl.Rows.Alignment = wdAlignRowCenter
        tbl.Rows.LeftIndent = CentimetersToPoints(0)
        tbl.PreferredWidthType = wdPreferredWidthPoints
        tbl.PreferredWidth = TableWidth
        Application.ScreenRefresh
    Next tbl
    i = i + 1
Next sec
Set fRange = Nothing
Set hRange = Nothing
Set efRange = Nothing
Set ehRange = Nothing
Set fhRange = Nothing
Set ffRange = Nothing
End Sub
Sub AllTablesWidth()
'Выравнивание всех таблиц по ширине текста
' Написан по мотивам макроса А.Кокина из книги
' "Word 2003/2007. Народные советы"
Dim arTable As Table ' определение таблицы как объекта "Таблица"
Dim arCurrentDoc As Document 'определение документа как объект "Документ"
Dim arPageWidth As Single ' Ширина страниц
Dim arLeftMargin As Single 'Отступ текста от левого края страницы
Dim arRightMargin As Single ' Отступ текста от правого края страницы
Dim arTableWidth As Single ' Ширина таблицы
Dim arIndexOfSections As Integer
Dim arMeter As Integer
Dim arStoryRangNumber As Integer
arIndexOfSections = ActiveDocument.Sections.Count
Set arCurrentDoc = ActiveDocument ' присвоение переменной имени текущего документа
For arMeter = 1 To arIndexOfSections ' от первого до последнего раздела
    arPageWidth = arCurrentDoc.Sections(arMeter).PageSetup.PageWidth ' присвоение переменной текущей ширины страницы
    arLeftMargin = arCurrentDoc.Sections(arMeter).PageSetup.LeftMargin ' присвоение переменной значения отступа текста от левого края страницы
    arRightMargin = arCurrentDoc.Sections(arMeter).PageSetup.RightMargin ' присвоение переменной значения отступа текста от правого края страницы
    arTableWidth = arPageWidth - (arLeftMargin + arRightMargin) 'Расчет ширины таблицы исходя из текущих значений переменных
    For Each arTable In ActiveDocument.Sections(arMeter).Range.Tables ' для каждой таблицы в выделенном разделе
        arTable.Rows.Alignment = wdAlignRowCenter 'выравнивание таблицы по центру страницы
        arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрах
        arTable.PreferredWidthType = wdPreferredWidthPoints 'тип автоподбора ширины таблицы
        arTable.PreferredWidth = arTableWidth 'собственно задание таблице ее новой ширины
    Next arTable ' работа со следующей таблицей
Next arMeter
End Sub
Sub SingleTablesWidth()
' Изменение ширины любой выбранной таблицы
' Ограничения для колонтитулов - перед таблицей в колонтитуле
' должно быть не больше двух строк (или двух однострочных абзацев)
 Dim arIndexOfSections As Integer
 Dim arN As Integer 'Порядковый номер раздела
 Dim arPageWidth As Single ' Ширина страниц
 Dim arLeftMargin As Single 'Отступ текста от левого края страницы
 Dim arRightMargin As Single ' Отступ текста от правого края страницы
 Dim arSingleTableWidth As Single
 Dim arCurrentDoc As Document
 Dim arTable As Table
 Set arCurrentDoc = ActiveDocument ' присвоение переменной имени текущего документа
    arN = Selection.Information(wdActiveEndSectionNumber) ' Номер колонтитула, первый изначально
    arPageWidth = arCurrentDoc.Sections(arN).PageSetup.PageWidth
    arLeftMargin = arCurrentDoc.Sections(arN).PageSetup.LeftMargin
    arRightMargin = arCurrentDoc.Sections(arN).PageSetup.RightMargin
    arSingleTableWidth = arPageWidth - (arLeftMargin + arRightMargin)
    If Selection.Information(wdWithInTable) Then
        Set arTable = Selection.Tables(1)
        arTable.Rows.Alignment = wdAlignRowCenter 'выравнивание таблицы по центру страницы
        arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрах
        arTable.PreferredWidthType = wdPreferredWidthPoints 'тип автоподбора ширины таблицы
        arTable.PreferredWidth = arSingleTableWidth 'собственно изменение ширины
    Else
        Selection.MoveDown Unit:=wdLine, Count:=1
            If Selection.Information(wdWithInTable) Then
                Set arTable = Selection.Tables(1)
                arTable.Rows.Alignment = wdAlignRowCenter 'выравнивание таблицы по центру страницы
                arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрах
                arTable.PreferredWidthType = wdPreferredWidthPoints 'тип автоподбора ширины таблицы
                arTable.PreferredWidth = arSingleTableWidth 'собственно изменение ширины
            Else
            Selection.MoveDown Unit:=wdLine, Count:=1
                    If Selection.Information(wdWithInTable) Then
                        Set arTable = Selection.Tables(1)
                            arTable.Rows.Alignment = wdAlignRowCenter 'выравнивание таблицы по центру страницы
                            arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрах
                            arTable.PreferredWidthType = wdPreferredWidthPoints 'тип автоподбора ширины таблицы
                            arTable.PreferredWidth = arSingleTableWidth 'собственно изменение ширины
                    Else
            Selection.MoveUp Unit:=wdLine, Count:=2
                    End If
            End If
End If
End Sub

1st Вот вам три процедуры:
1-я (AllHeadersTablesWidth) выравнивает по ширине текста все таблицы во всех колонтитулах
2-я  (AllTablesWidth) выравнивает по ширине текста все таблицы в основном тексте
3-я (SingleTablesWidth) выравнивает по ширине текста отдельно взятую таблицу (и в основном тексте и в колонтитуле).

Сам только недавно закочил эти макрсосы. Проверено не раз - все работает!

13

Re: Форматирование таблиц

viter.alex - человек хотел именно того, что приведено в макросах выше. Так как я сам над этим думал, сразу понял его вопрос.. smile

14

Re: Форматирование таблиц

andrkar спасибо! smile
Все работает!!!

15

Re: Форматирование таблиц

andrkar, а зачем вот эта строчка?

arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрах
Лучше день потерять — потом за пять минут долететь!

16

Re: Форматирование таблиц

Может и не нужна:) попробую убрать:)

17

Re: Форматирование таблиц

andrkar, пользуюсь твоей работо

18

Re: Форматирование таблиц

andrkar, пользуюсь твоей работой с удовольствием. Но при применении макроса к документу в формате А5, приводит к некорректному результату. как можно решить эту проблему?
Спасибо!

19

Re: Форматирование таблиц

1st. А поконкретнее можно? Какая именно процедура из трех? и в чем некорректность результата? чтобы мне знать, где конкретно искать.. С форматом А5 действительно не тестировал.. sad
Сейчас попробовал вставить несколько разных таблиц и в колонтитулы и в основной текст на формате А5. Все отработало.
Применяя сам этот макрос замечал, что некоректно работает только с таблицами, которые получались объединением двух разных таблиц, если удалить знаки абзацев между ними..
Так что жду более конкретной информации от вас, чтобы исправить ошибку. Можете файлик свой приложить с вашими таблицами в А5?

Отредактировано andrkar (10.04.2010 15:44:35)

20

Re: Форматирование таблиц

Приношу извинения! Почему-то теперь все ок wink

Отредактировано 1st (10.04.2010 15:47:07)

21

Re: Форматирование таблиц

эффект присутствия:) Вроде макрос независим от размера страницы.. там все из данных параметров страницы для каждого раздела рассчитывается.. smile
Да, еще посмотрите http://wordexpert.ru/forum/viewtopic.php?id=212. Там выложено усовершенствование для предложенных макросов

Отредактировано andrkar (10.04.2010 16:05:46)