Последние записи
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
24th
Фев
Форматирование таблиц в документе (Microsoft Office Word)
Posted by obzor under VBA
В процессе работы есть необходимость форматировать в единый стиль много документов, которые содержать таблицы и текст. (подготовка для HTML)
В макросах не сильна, только начинаю разбираться и читать. Помогите с написанием макроса.
В итоге документы должны иметь такой вид:
Шрифт Verdana 8
Удалить все колонтитулы
Таблицы по середине, по ширине страницы, границы определенные (файл прикрепляю).
Желательно, чтобы внутри таблиц первый столбец по левому краю выравнивание, Шапка — по центру, остальные ячейки по нижнему правому краю.
И совсем из нереального для понимания моего мозга: если есть пустые ячейки с таблице (без каких-либо символов), то вставить туда пробел.
Sub Макрос()
Application.ScreenUpdating = False
With ActiveDocument.Range.Font ' установка шрифта
.Name = "Verdana"
.Size = 8
End With
Dim S As Section, Header As HeaderFooter
' удаляем колонтитулы
For Each S In ActiveDocument.Sections
For Each Header In S.Headers
Header.Range.Delete
Next
For Each Header In S.Footers
Header.Range.Delete
Next
Next
Dim colCount&, rowCount&, Center&, i&, j&, y&
Dim Col As Range, Table As Table, EmptyCell$
EmptyCell = Chr(13) & Chr(7)
On Error Resume Next
For Each Table In ActiveDocument.Tables ' для всех таблиц
With Table
' установка рамки
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleOutset
.Borders(wdBorderVertical).LineStyle = wdLineStyleOutset
.Borders.OutsideLineStyle = wdLineStyleOutset
colCount = .Columns.Count ' количество колонок
rowCount = .Rows.Count ' количество строк
' поиск строки после заголока
For i = 2 To rowCount
Err.Clear
For j = 1 To colCount
y = .Cell(i, j).Range.Bold
If Err.Number Then Exit For
Next
If j > colCount Then Exit For
Next
' установка выравнивания для заголовка
For Center = 1 To i - 1
For j = 1 To colCount
With .Cell(Center, j)
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.VerticalAlignment = wdCellAlignVerticalCenter
If .Range.Text = EmptyCell Then .Range.Text = " "
End With
Next j, Center
' поиск номера столбца "Единицы измерения"
Set Col = .Range
If Col.Find.Execute(FindText:="Единицы измерения", MatchWholeWord:=True) Then
Center = Col.Cells(1).ColumnIndex
Else
Center = 0
End If
Err.Clear
' обход строк таблицы после заголовка
For i = i To rowCount
y = .Cell(i, 2).Range.Bold
If Err.Number = 0 Then
With .Cell(i, 1)
.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
.VerticalAlignment = wdCellAlignVerticalCenter
If .Range.Text = EmptyCell Then .Range.Text = " "
End With
' для всех ячеек строки i
For j = 2 To colCount
With .Cell(i, j)
If j = Center Then
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.VerticalAlignment = wdCellAlignVerticalBottom
Else
.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
.VerticalAlignment = wdCellAlignVerticalBottom
End If
If .Range.Text = EmptyCell Then .Range.Text = " "
End With
Next
Else
With .Cell(i, 1)
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.VerticalAlignment = wdCellAlignVerticalCenter
If .Range.Text = EmptyCell Then .Range.Text = " "
End With
Err.Clear
End If
Next
End With
Next
Set Col = Nothing
Application.ScreenUpdating = True
End Sub
Случайные статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)