Удаление пустых строк в таблице

[Semen90]

Автоматически создаються документы в ворде на несколько сотен страниц состоящие из текста и таблиц. Вопрос как удалить пустые строки в табличной части документа

[Sasha_Smirnov]

Выделить их и удалить. Хотите сделать это макросом, судя по всему?

А вот когда они создаюТСЯ — ведь можно пустых строк и не создавать. Дайте пример.

[Semen90]

создаються они профессиональной программой и изменить что либо я не могу, пробовал в шаблонах и так и эдак все равно выходят пустые строки, удалять их вручную на нескольлких сотty страниц - убиться можно, да и просто пропустить. часть файла (пример) находиться по следующей ссылки http://files.mail.ru/S1N16D

[Sasha_Smirnov]

Извините, но 100 Мб загружать я не буду. У меня всего свободно 240!

Попробуйте поискать более профессиональную программу.

[viter.alex]

Sasha_Smirnov, насчет 100 Мб ты что-то напутал. Там 128,5 кб.
Кое-что получилось. Так должно быть или ещё нужно удалять ячейки с прочерками?
Хороша профессиональная программа!

[Semen90]

Да именно так , можно все конечно и в ручную, но повторяюсь, что документы создаються порой более чем на 1000 страниц. Буду рад за помощь или подсказку, VBA не мой конек - однозначно

[viter.alex]

Sub DeleteEmptyRows()

  On Error Resume Next
  
  Dim oDocCurr As Document 'Рабочий документ
  Dim oTbl As Table 'Текущая таблица
  Dim oCell As Cell 'Ячейка в таблице
  Dim oRowRng As Range 'Диапазон для строки
  Dim iStart As Long 'Начало первой пустой ячейки в строке
  Dim iEnd As Long 'Конец последней пустой ячейки в строке
  Dim i As Long 'Счетчик строк в таблице
  Dim j As Long 'Счетчик таблиц
  Dim sEmptyString As String 'Служебная строка
  
  Set oDocCurr = ActiveDocument 'Запоминаем активный документ
  'Перебираем таблицы в документе, начиная с конца документа
  For j = oDocCurr.Tables.Count To 1 Step -1
    Set oTbl = oDocCurr.Tables(j) 'Запоминаем таблицу
    'Перебираем ячейки в первом столбце
    For i = oTbl.Rows.Count To 1 Step -1
      If Len(oTbl.Cell(i, 1).Range.Text) = 2 Then 'Если ячейка пустая, т.е. содержит только конец абзаца и конец ячейки
        If Err.Number <> 5941 Then 'Если такая ячейка существует
          Set oCell = oTbl.Cell(i, 1) 'Запоминаем первую ячейку в строке
          If Not oCell Is Nothing Then 'Если ячейка запомниалась
            iStart = oCell.Range.Start 'Запоминаем ее начало
            Do While Len(oCell.Next.Range.Text) = 2 'Теперь ищем последнюю пустую ячейку в этой же строке
              iEnd = oCell.Next.Range.End 'Запоминаем ее конец
              Set oCell = oCell.Next
            Loop
            Set oRowRng = oDocCurr.Range(iStart, iEnd) 'Запоминаем диапазон от начала первой пустой ячейки до конца последней
            'Удаляем из строки знаки абзаца и конца ячейки
            sEmptyString = Replace(oRowRng.Text, ChrW(13) & ChrW(7), "")
            If Len(sEmptyString) = 0 Then 'Если строка пустая,
              oRowRng.Cells.Delete ' то ячейки удаляем
              oDocCurr.Save 'документ сохраняем
            End If
          End If
        Else: Err.Clear 'очищаем ошибку
        End If
      End If
    Next i
  Next j
End Sub

[Semen90]

Огромное спасибо, макрос работает!!! Единственный вопрос чем вызванно столь частое сохранение документа, пример - 90 страниц макрос обработал за 3 минуты, а если страниц 1500 то частое сохранение намного увеличит время обработки. Поймите правильно я не привередничую, просто хочу понять , я рад и тому что Вы уже написали, это все же не руками, и уж точно не пропустишь строку

[viter.alex]

Эту строку можно закомментировать. Просто когда я отлаживал макрос, то Word вылетал несколько раз, ну и чтобы не терять наработанное, я поставил сохранение

[Semen90]

Еще раз спасибо! сечас попробую протестировать на самом большом документе, результаты сообщу