1

Тема: Снова удаление пробелов в таблицах

Здравствуйте!

Пытался слепить макрос из того, что смог найти на форуме (отсюда названия переменных и прочее), но не выходит.

Нужно удалить пробелы в начале и конце каждой ячейки каждой таблицы, вроде начинается нормально, а когда переходит на вторую таблицу, выдаёт ошибку "Запрашиваемый номер семейства не существует".

Вот текст, сильно не бейте, последний раз программировал на паскале в прошлом веке, синтаксиса ворд-бейсика практически не знаю sad

Предполагается, что перед этим был выполнен другой макрос, который удаляет пробелы до и после символа конца абзаца, так что пробелы остаются только в начале и конце ячеек таблицы.


Sub TrimCellText()
'Удаление пробелов до и после текста в ячейке таблицы
  Dim opar As Paragraph
  Set opar = ActiveDocument.Paragraphs.First 'надеюсь использовать это, чтобы определить конец документа
  Dim oTbl As Table 'Таблица, в которой будем перебирать ячейки
With Selection
    .WholeStory
    .HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdStory
a = 0
Do Until opar Is Nothing  'надеюсь использовать это, чтобы определить конец документа и завершить выполнение,
'пока не проверял даже, может, достаточно будет завершить, когда счетчик а будет равен числу таблиц в документе
       If Selection.Information(wdWithInTable) Then
          a = a + 1
          Dim xCell As Cell 'для перебора ячеек и выхода из таблицы
          Set oTbl = ActiveDocument.Tables(a)
          Set xCell = oTbl.Range.Cells(a)
          Dim oCell As Cell
          Set oCell = oTbl.Range.Cells(a)
'на следующей строчке выдаётся ошибка, когда начинается обработка второй таблицы
'с первой таблицей всё проходит на ура
            For Each oCell In Selection.Tables(a).Range.Cells

               oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
            Next
            Do Until xCell Is Nothing
              Set xCell = xCell.Next 'Попытка вылезти из таблицы перебором ячеек
'уродство, знаю, а что делать? работает - не трогаю
              If Not xCell Is Nothing Then Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove Else: .MoveRight Unit:=wdWord, Count:=3
            Loop
        Else: .MoveRight Unit:=wdWord
        End If
    Set opar = opar.Next
Loop
End With
Selection.HomeKey Unit:=wdStory 'поехали в начало, нам ещё документ редактировать

End Sub

2

Re: Снова удаление пробелов в таблицах

незнаю, если не рубите, зачем фор еахи, до тех пора рак свиснет
на одну строку больше но понятней
а=ActiveDocument.Tables.Count
затем цикл согласно а, или сразу
For а = 1 To ActiveDocument.Tables.Count
что нужно
Next

3

Re: Снова удаление пробелов в таблицах

Спасибо, конечно, но вообще ничего не понял из ответа. Можно на нормальном языке, без "фор еахи"?

Меня интересует, как обработать каждую ячейку в таблице(А).
Кусок макроса, который был в одной из тем, отлично вычищает все пробелы в начале и конце каждой ячейки таблицы, в которой находится курсор, а именно:
            For Each oCell In Selection.Tables(a).Range.Cells
               oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
            Next
Если курсор не находится в таблице, при попытке выполнения этого цикла выдаётся ошибка. Поэтому сначала приходится дотащить его до таблицы и войти в неё, не трогая больше ничего. Если курсор в таблице - всё работает отлично.
Проблема в том, что к тому моменту, когда курсор вползает во вторую таблицу, этот цикл уже не работает.

Как изменить макрос, чтобы успешно обрабатывались все таблицы в документе, а не только первая?

4

Re: Снова удаление пробелов в таблицах

Разобрался, в чём была причина.

В итоге всё выглядит вот так (от перехода по параграфам пришлось отказаться - на середине документа макрос почему-то остановился; вариант "for a = 1 to ActiveDocument.Tables.Count" тоже не прокатил):

Sub TrimCellText()
'Удаление пробелов до и после текста в каждой ячейке каждой таблицы в документе
 
Dim oTbl As Table
With Selection
    .WholeStory
    .HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdStory
a = 0
numtables = ActiveDocument.Tables.Count
Do Until a = numtables
        If Selection.Information(wdWithInTable) Then
          a = a + 1
          Dim xCell As Cell
          Set oTbl = ActiveDocument.Tables(1)
          Set xCell = oTbl.Range.Cells(1)
          Dim oCell As Cell
          Set oCell = oTbl.Range.Cells(1)
            For Each oCell In Selection.Tables(1).Range.Cells
            oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
            Next
            Do Until xCell Is Nothing
              Set xCell = xCell.Next
              If Not xCell Is Nothing Then Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove Else: .MoveRight Unit:=wdWord, Count:=3
            Loop
        Else: .MoveRight Unit:=wdWord
        End If
Loop
End With
Selection.HomeKey Unit:=wdStory

End Sub


Очень надеюсь, что эта штука не убивает картинки в документе))

5

Re: Снова удаление пробелов в таблицах

вот непонятные Вам фор еахи - For Each, что означает - до тех пор
Не надо отталкиватться от того где курсор, пусть хоть где стоит, делайте цикл

For а = 1 To ActiveDocument.Tables.Count
что нужно, а нужно узнать сколько ячеек в табл и опять цикл по количеству ячеек в табл.
Next

и выделяйте свои коды тегами

6

Re: Снова удаление пробелов в таблицах

в самом начале

Selection.HomeKey Unit:=wdStory

это ни к чему

7

Re: Снова удаление пробелов в таблицах

одним словом тяжело без тегов код смотреть, вроде Вы уже пытались как я говорил делать, оформляйте код

8

Re: Снова удаление пробелов в таблицах

Спасибо, друже.

Блин, фигня какая-то с форумом, мало того, что не могу свои сообщения редактировать, приходится одно и то же по несколько раз отправлять, так ещё ни одной картинки для форматирования не могу найти - одни значки не найденных картинок (типа вот по такой ссылке http://wordexpert.ru/buttons/Oxygen/color.png)

Как узнать, сколько ячеек в таблице, я не знаю (вариант с рядами и столбцами не прокатывает из-за частого объединения ячеек в документах, с которыми я работаю - после распознавания), поэтому приходится перебирать ячейки, пока таблица не кончится.

Sub TrimCellText()
  
Dim oTbl As Table
With Selection
    .WholeStory
    .HomeKey Unit:=wdStory
a = 0
numtables = ActiveDocument.Tables.Count
Do Until a = numtables
        If Selection.Information(wdWithInTable) Then
          a = a + 1
          Dim xCell As Cell
          Set oTbl = ActiveDocument.Tables(1)
          Set xCell = oTbl.Range.Cells(1)
          Dim oCell As Cell
          Set oCell = oTbl.Range.Cells(1)
            For Each oCell In Selection.Tables(1).Range.Cells
            oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
            Next
            Do Until xCell Is Nothing
              Set xCell = xCell.Next
              If Not xCell Is Nothing Then Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove Else: .MoveRight Unit:=wdWord, Count:=3
            Loop
        Else: .MoveRight Unit:=wdWord
        End If
Loop
End With
Selection.HomeKey Unit:=wdStory

End Sub

Теперь всё работает, наверное, больше трогать не буду, чтобы не сломать.

9

Re: Снова удаление пробелов в таблицах

Daist, попробуйте в настройках профиля снять галку с "Использовать графические кнопки в панели ББ-кодов "

10

Re: Снова удаление пробелов в таблицах

Спасибо, теперь кнопки появились.
Странно, что по умолчанию эта галка стоит, раз картинки не находятся sad

11

Re: Снова удаление пробелов в таблицах

из-за частого объединения ячеек в документах не катит. И Вы придумали свой, не верю, завтра посмотрю

12

Re: Снова удаление пробелов в таблицах

Это не мой способ smile Практически всё нашёл тут на форуме и слепил, как смог, т.к. конструкции типа Длинная.Непонятная.Мне.Структура вводили меня в ступор ещё на этапе Turbo Vision (была такая надстройка к TP 7.0), а поскольку я редактор, а не программист, макросы рассматриваю исключительно с точки зрения их работоспособности, а не красоты/изящности кода, увы, на изучение языка времени нет smile А оптимизацию я ещё на этапе ассемблера забросил в 97-99 году.

13

Re: Снова удаление пробелов в таблицах

пока времени нет, бегло посмотрел, почему Бы не сделать так

Dim oTbl As Table
For ы = 1 To ActiveDocument.Tables.Count

          Dim xCell As Cell
          Set oTbl = ActiveDocument.Tables(ы)
          Set xCell = oTbl.Range.Cells(1)
          Dim oCell As Cell
          Set oCell = oTbl.Range.Cells(1)
            For Each oCell In Selection.Tables(ы).Range.Cells
            oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
            Next
            Do Until xCell Is Nothing
              Set xCell = xCell.Next
              If Not xCell Is Nothing Then Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove Else: .MoveRight Unit:=wdWord, Count:=3
            Loop
        Else: .MoveRight Unit:=wdWord
        End If
Next ы
End With
Selection.HomeKey Unit:=wdStory

что Вы пристали к
.WholeStory выделить всё
    .HomeKey Unit:=wdStory уйти в начало документа,  а если табл. на 6 листе
так и будете
.MoveRight Unit:=wdWord спускаться вниз, зачем??
приведённый мною код пока запинается, просто до вечера, нет времени

14

Re: Снова удаление пробелов в таблицах

Попробовал Ваш код, да, запинается и выдаёт ошибку при попытке чистки таблицы, если курсор находится не в таблице.

Нашёл 1 косяк, старый код проверки на выход из таблицы не работал, если в таблице есть столбец, состоящий из 2 объединённых рядов - в этом случае курсор ещё в таблице, а xCell.next уже считала, что она = nothing, и заканчивала выход из таблицы. Пришлось всё упростить, дубово, но зато теперь объединённые ячейки не являются препятствием. От перемещения ячейками (wdCell) пришлось отказаться, т.к. при попытке перемещения из последней ячейки такой способ просто создаёт новую, пустую ячейку, и так происходит до бесконечности. Прыгаю словами (wdWord), пусть дольше, но зато надёжнее.
На тестовый документ из 30 страниц ушло около 11 секунд, причём похоже, что время ограничивается скоростью прокрутки документа (работаю в терминале, тормозит), пробовал скакать по таблице не по 1, а по 2 слова - результат по времени тот же.

Sub TrimCellText()
'Удаление пробелов до и после текста в каждой ячейке каждой таблицы в документе 
Dim oTbl As Table
With Selection
    .HomeKey Unit:=wdStory
a = 0
numtables = ActiveDocument.Tables.Count
Do Until a = numtables
        If Selection.Information(wdWithInTable) Then
          a = a + 1
          Set oTbl = ActiveDocument.Tables(1)
          Dim oCell As Cell
          Set oCell = oTbl.Range.Cells(1)
            For Each oCell In Selection.Tables(1).Range.Cells
            oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
            Next
           Do Until Selection.Information(wdWithInTable) = False
               Selection.MoveRight Unit:=wdWord, Count:=1
           Loop
        Else: .MoveRight Unit:=wdWord
        End If
Loop
End With
Selection.HomeKey Unit:=wdStory

End Sub

15

Re: Снова удаление пробелов в таблицах

Ах да, и .HomeKey Unit:=wdStory мне нужно, чтобы гарантированно начать с начала документа и точно найти и обработать именно то число таблиц, которое есть.

16

Re: Снова удаление пробелов в таблицах

Обнаружился ещё 1 баг, который, похоже, станет фичей - при если в ячейке 2 абзаца, и у них разное форматирование, то первый абзац приобретает выравнивание второго. Ну и чёрт с ним.

17

Re: Снова удаление пробелов в таблицах

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

Option Explicit

Sub TrimCellText()

'во всех таблицах документа Ворд, во всех ячейках убрать пробелы в начале и в конце ячейки
'макрос работоспособен и в случаях, когда в таблицах объеденены ячейки
Dim oTbl As Table
Dim oCell As Cell

'объявление переменной типа "Integer"
'этим переменным можно присваивать только целочисленные значения, размер 2 байта, от -32768 до + 32767
Dim w As Integer

For w = 1 To ActiveDocument.Tables.Count
Set oTbl = ActiveDocument.Tables(w)
Set oCell = oTbl.Range.Cells(1)
For Each oCell In ActiveDocument.Tables(w).Range.Cells
oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))
Next
Next w
'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Set oTbl = Nothing
Set oCell = Nothing
End Sub

18

Re: Снова удаление пробелов в таблицах

А Вы попробуйте запустить этот код и проверить его выполнение...

For Each oCell In ActiveDocument.Tables(w).Range.Cells
oCell.Range.Text = Trim(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2))

Вот эта конструкция у меня не работает, если курсор не стоит в таблице, плюс выдаётся ошибка даже при наличии курсора в таблице, если стоит 
ActiveDocument.Tables(<имя_переменной>).Range.Cells,
а не
ActiveDocument.Tables(1).Range.Cells

19

Re: Снова удаление пробелов в таблицах

на работе проверял работает!!
выбросьте из головы мысли о курсоре, пусть хоть где стоит!!
сейчас Ворда нет
не знаю, что сказать

20

Re: Снова удаление пробелов в таблицах

Всё, разобрался, работает, спасибо большое!

Я не знал, как использовать любую таблицу документа, а не только ту, в которой курсор, теперь вижу.

Ну, теперь можно начинать работу над следующим.. автоматическое приведение даты на английском в соответствие формату, но это теперь не скоро smile Уж больно геморно - вручную искать в тексте фразы типа "April 20 2010" и переделывать в "April 20th, 2010". Я так понимаю, надо хранить 2 типа массивов - с неправильным и правильным написанием, в цикле проверить строку на соответствие одному элементу из первого массива (месяц), убедиться, что рядом есть ещё элементы из 2 других массивов (число и год), а потом взять из второго типа массива правильный вариант ("1" -> "1st,", "2" -> "2nd,", "10" -> "10th," и так до 31) и заменить всю строку...  Правда, не знаю, разрешает ли ворд осуществлять замену строковыми переменными, а не только текстом.
Ладно, неважно, это пока мечты от лени)

Ещё раз спасибо!

21

Re: Снова удаление пробелов в таблицах

что-то Вы завернули, пустяковая задача
вручную искать в тексте фразы типа "April 20 2010" и переделывать в "April 20th, 2010"
Не понял юмора th добавить?

22

Re: Снова удаление пробелов в таблицах

Не просто добавить, а вот так:
Просмотреть весь документ, найти даты, написанные в неправильном формате
к диапазону 4-20, 24-30 добавить "th,"
к 1, 21, 31 добавить "st,"
к 2, 22 добавить "nd,"
к 3, 23 добавить "rd,"

А, ну и эти добавки должны быть в верхнем индексе.

Добавлять нужно исключительно в том случае, когда число - элемент полной даты формата
MMMM DD(,) YYYY
где
MMMM - название месяца на английском
DD(,) - дата с 1 по 31, после которой может или не может быть запятая (это уж как взбрело в голову написавшему), если она есть - не трогаем, если нет - добавляем
YYYY - год (скажем, с 1900 по 2050)

23

Re: Снова удаление пробелов в таблицах

Вы хоть скажите для общего развития, что означает
"th,"
"st,"
"nd,"
"rd,"
Наверное понял типа 20е??? Так??
Можно так - Специальные символы и подстановочные знаки в операциях поиска и замены MS Word 97/2000/XP внешняя ссылка
По умному это делается при помощи регулярок, и советую сделать по умному
попотеть придётся за то потом нирвана...
вот пример

'возможно нужно подключить библиотеку Reference > Microsoft VBScript Regular Expressions 5.5

Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
'искать по всему тексту, если False по-умолчанию или строка отсутствует - будет найдено только первое совпадение
reg.Global = True
'+ означает, что заменяем и два и три и четыре и более пробелов подряд
reg.Pattern = " +"
........
'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Set reg = Nothing

заменяет, два и более пробела подряд на один, если поймёте гуглите регулярные выражения

24

Re: Снова удаление пробелов в таблицах

вот ещё пример

Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True 'искать по всему тексту, если False (по-умолчанию) - будет найдено только первое совпадение
str1 = "Winowsdows FreeWind MagicWin95"
objRegExp.Pattern = "ows\b"  '\b маленькое строго в конце слова
'objRegExp.Pattern = "\bWin" '\b маленькое строго в начале слова
Set objMatches = objRegExp.Execute(str1)
MsgBox objMatches.Count
objRegExp.Pattern = "ows\B" '\B большое строго не в конце слова
'objRegExp.Pattern = "\BWin" '\B большое строго не в начале слова
Set objMatches = objRegExp.Execute(str1)
MsgBox objMatches.Count

когда нагуглите по регулярным выражения инфу дайте ссылку я потерял свою

25

Re: Снова удаление пробелов в таблицах

Ципихович Эндрю пишет:

Вы хоть скажите для общего развития, что означает
"th,"
"st,"
"nd,"
"rd,"

Да, это буквы типа "-ое", которые добавляются к числу, но в русском это "-ое" или "-е" (3-е), а в английском идёт 1st, 2nd, 3rd, 4th, 5th, 6th, ....19th, 20th, 21st, 22nd, 23rd, 24th, 25th, ...30th, 31st.

Да ладно, не заморачивайтесь, это я так, в общем на будущее возможное направление работы обозначил, пока этим заниматься не буду, для меня сложновато.

26

Re: Снова удаление пробелов в таблицах

ну и зря

27

Re: Снова удаление пробелов в таблицах

вот Вам ссылка внешняя ссылка
и снова в бой

28

Re: Снова удаление пробелов в таблицах

Спасибо, попозже попробую разобраться, меня ещё пока от работы на прошлой неделе накрывает - по идее, я должен делать 150-200 страниц в неделю, а сделал 650. До сих пор не отошёл.

29

Re: Снова удаление пробелов в таблицах

мне б такую работу - делать 150-200 страниц в неделю, за день бы сделал и пошёл бы спать smile))

30

Re: Снова удаление пробелов в таблицах

Ага, только небольшая проблема есть - сначала надо дождаться, пока эти страницы придут, а потом уже делать: сверить исходник и перевод, сверить по глоссариям, проверить орфографию, проверить в инете правильность перевода оборотов и т.д., сделать форматирование по требованиям заказчика, плюс доверстать местами, где переводчики поленились (если много - документ уходит на вёрстку). Вот я и пытаюсь автоматизировать по возможности всякую рутину типа удаления лишних пробелов.
Плюс делать надо не 150-200, а столько, сколько дадут, и не за день, а именно тогда, когда дадут, и именно к тому сроку, когда надо сдать. smile

31

Re: Снова удаление пробелов в таблицах

Такс, очередной косяк в макросе - удаляет в начале и конце ячейки всё, что не текст, в том числе и картинки)) Будет время - буду искать, как определять, что слева или справа от курсора находится пробел)

32

Re: Снова удаление пробелов в таблицах

Мне понадобилось сделать следующее: во всех таблицах  удалить неразрывные пробелы, которые стоят в начале текста. Т.е. содержимое ячейки начинается например с "неразрывный пробел (всегда один) - знак меньше - цифра"; нужно, чтобы стало "знак меньше - цифра"
Как это можно реализовать с помощью макроса?
Близкая задача: определить, какой знак стоит первым в ячейке. Если это англ. P или русская Р, то заменить их на маленькую англ. р курсивом.
Кто подскажет решение?