Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Добрый день
По работе часто форматриую всяческие таблицы. При этом - основное требование:
для отрицательных (они оторбажаются в скобках) - отступ справа 0
для положительных - 0.1
Возможно ли процесс форматирования автоматизировать с помощью макроса?
Спасибо
Форматирование таблицы (выравнивание, границы и т.п.) с помощью макроса возможно. Нужно лишь знать, что именно, какие параметры вы хотите задать.
Что это за требование, о котором вы упоминаете? Что за
для отрицательных (они оторбажаются в скобках) - отступ справа 0
для положительных - 0.1
О чем это вы, уточните.
В таблице есть как отрицательные, так и положительные цифры (отрицательные в скобкак - бухгалтерский формат)
Положительные цифры должны быть отформатированы (indentation rigth 0.1), Отрицательные (indentation right 0).
Я приложил небольшой примерчик. И мне интересно, можно ли написать такой макрос, который определяет положительное чилсло или отрицательное и применяет нужное форматирование.
Вот так, что ли?
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
Посмотрел. Не подойдёт, хотя не сложно переделать Я так понимаю, что нужно выровнять запятые? Чтобы разряды были строго друг под другом? Это делается при помощи табуляции по разделителю, а не отступами
Не совсем. Он не отличает отрицательных от положительных. Наверное, потому, что в моей табличке отрицательные цифры без минуса, в скобках. И еще он форматирует все цифры в табличке. А хотелось бы только выделенные.
add. Именно отступами
Отредактировано smokky (24.03.2010 12:01:35)
Тогда так. Если ячейки выделены в разных местах таблицы, то форматируются только последние. Если выделение спложное, то форматируются все.
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Но, повторюсь, нужно выравнивать с помощью табуляции по разделителю.
По форматированию, к сожалению, такие требования(
За макрос - спасибо огромное. Все работате просто супер 
Пожалуйста, но я всё-таки предложу вариант и с табуляцией. Только для одного выделенного столбца:
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Привет.
Если применить для произвольной таблицы команду "Автоподбор по ширине окна", Word автоматически подгонит таблицу по ширине окна, но мне нужно подогнать таблицу по границе текста, тоже автоматически и желательно для всех таблиц в документе. 
Спасибо 
Отредактировано 1st (04.04.2010 15:30:23)
Т.е. вы хотите сказать, что таблица сверху выровнена по ширине окна, а таблица снизу по ширине текста? Это не так. Во второй таблице левая граница текста в ячейке совпадает левой границей страницы, а правая граница текста в ячейке — с правой границей страницы.
Собственно, чего вы хотите добиться?
Мне нужно чтобы края таблицы совпадал с границами текста, как "Таблица 2"
В документе очень много таблиц и все они вида "Таблица 1". Трудоемко каждую таблицу подтягивать к границам текста.
Спасибо
Отредактировано 1st (04.04.2010 22:23:55)
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 Sub1st Вот вам три процедуры:
1-я (AllHeadersTablesWidth) выравнивает по ширине текста все таблицы во всех колонтитулах
2-я (AllTablesWidth) выравнивает по ширине текста все таблицы в основном тексте
3-я (SingleTablesWidth) выравнивает по ширине текста отдельно взятую таблицу (и в основном тексте и в колонтитуле).
Сам только недавно закочил эти макрсосы. Проверено не раз - все работает!
viter.alex - человек хотел именно того, что приведено в макросах выше. Так как я сам над этим думал, сразу понял его вопрос..
andrkar спасибо!
Все работает!!!
andrkar, а зачем вот эта строчка?
arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрахМожет и не нужна:) попробую убрать:)
andrkar, пользуюсь твоей работо
andrkar, пользуюсь твоей работой с удовольствием. Но при применении макроса к документу в формате А5, приводит к некорректному результату. как можно решить эту проблему?
Спасибо!
1st. А поконкретнее можно? Какая именно процедура из трех? и в чем некорректность результата? чтобы мне знать, где конкретно искать.. С форматом А5 действительно не тестировал.. 
Сейчас попробовал вставить несколько разных таблиц и в колонтитулы и в основной текст на формате А5. Все отработало.
Применяя сам этот макрос замечал, что некоректно работает только с таблицами, которые получались объединением двух разных таблиц, если удалить знаки абзацев между ними..
Так что жду более конкретной информации от вас, чтобы исправить ошибку. Можете файлик свой приложить с вашими таблицами в А5?
Отредактировано andrkar (10.04.2010 15:44:35)
Приношу извинения! Почему-то теперь все ок 
Отредактировано 1st (10.04.2010 15:47:07)
эффект присутствия:) Вроде макрос независим от размера страницы.. там все из данных параметров страницы для каждого раздела рассчитывается..
Да, еще посмотрите http://wordexpert.ru/forum/viewtopic.php?id=212. Там выложено усовершенствование для предложенных макросов
Отредактировано andrkar (10.04.2010 16:05:46)
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться