Последние записи
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
- Взаимодействие через командную строку
- Сравнение языков на массивах. Часть 1
- Сравнение языков по скорости
- Чтение огромных xml-файлов
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
15th
Дек
Удаление пустых абзацев в ячейках таблиц (MS Word)
Posted by obzor under VBA
Столкнулся со следующей задачей, которую не получается решить.
В документе Word 60 из страниц встречается много таблиц. Файл прилагаю.
Проблема в том, что в большинстве ячеек этих таблиц имеются пустые абзацы перед текстом и после него (т.е. в верху и внизу ячеек).
Надо удалить их все.
Попробуйте так:
Sub RemoveBlankParagraphs()
' Удаление пустых параграфов во всех ячейках всех таблиц документа
' https://www.programmersforum.ru/showthread.php?t=346549
' -------------------------------------------------------------------------------------------------/
Dim objDoc As Document, objRange As Range, objRangeP As Range
Dim objTable As Table, objCell As Cell, objParagraph As Paragraph
Dim iVal%
' -------------------------------------------------------------------------------------------------/
On Error GoTo RemoveBlankParagraphs_Err
Set objDoc = ActiveDocument
iVal = objDoc.Tables.Count
If iVal = 0 Then ' no point if there are no tables
MsgBox "Документ не содержит таблиц!", vbExclamation
GoTo RemoveBlankParagraphs_End
End If
iVal = 0
For Each objTable In objDoc.Tables
For Each objCell In objTable.Range.Cells
Set objRange = objCell.Range
For Each objParagraph In objRange.Paragraphs
Set objRangeP = objParagraph.Range
If Trim(objRangeP.Text) = vbCr Then
objRangeP.Delete
iVal = iVal + 1
End If
Next objParagraph
Next objCell ' к следующей ячейке
Next objTable ' goes to next table
If iVal > 0 Then
MsgBox "Удалено: " & iVal & " пустых параграфов в ячейках таблиц.", vbInformation, "Info"
Else
MsgBox "Пустых параграфов в ячейках таблиц не найдено.", vbInformation, "Info"
End If
RemoveBlankParagraphs_End:
On Error Resume Next
Set objParagraph = Nothing
Set objRangeP = Nothing
Set objRange = Nothing
Set objCell = Nothing
Set objTable = Nothing
Set objDoc = Nothing
Err.Clear
Exit Sub
RemoveBlankParagraphs_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub :" & _
"RemoveBlankParagraphs - ThisDocument.", vbCritical, "Error!"
Err.Clear
Resume RemoveBlankParagraphs_End
End Sub
Случайные статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)