Макрос слова, чтобы разгруппировать текстовые поля - PullRequest
Новая
       6

Макрос слова, чтобы разгруппировать текстовые поля

0 голосов
/ 02 июля 2018

Я работаю в офисе службы по делам инвалидов, и мы часто делаем одну вещь - увеличиваем документы Word, которые были преобразованы из PDF. Чтобы упростить процесс, я работал над «написанием» макроса (в основном копированием и вставкой битов из другого места или из устройства записи макросов), чтобы сделать такие вещи, как удаление лишних разрывов абзаца или «нормализация» стиля шрифта / размера / интервала /etc.

Часто, когда мы конвертируем файл PDF в файл Word, мы получаем часть текста в текстовых полях. Я хотел бы иметь возможность удалить текст из всех текстовых полей и заменить их на простой текст. Меня не волнует сохранение форматирования текста или сохранение декоративных линий, а что нет. Я нашел некоторый код в моем поиске, который работает для текстовых полей, которые не сгруппированы, но у меня есть документ, в котором текстовые поля сгруппированы.

Я нашел макрос, который должен разгруппировать фигуры, включая текстовые поля. Но когда я запускаю макрос, строка разгруппировки выдает сообщение об ошибке; «Ошибка времени выполнения '-2147024891 (80070005)': группа заблокирована и ее нельзя разгруппировать" Я могу вручную выбрать и разгруппировать текстовые поля, ЕСЛИ Я не установил их вручную, чтобы они были встроены в документ, после чего " «Разгруппировка» выделена серым цветом на вкладке. Если я просто копирую текстовое поле в новый документ и запускаю макрос разгруппировки, он работает как задумано, но только после того, как я вручную установил для группы что-то отличное от встроенного. Если я оставлю его как встроенный, макрос выдаст то же сообщение об ошибке.

Код, о котором идет речь: 

Sub Ungroup
    Dim xNmbr As Integer
    Dim strText As String
    With ActiveDocument
    For xNmbr = .Shapes.Count To 1 Step -1
    .Shapes(xNmbr).Select
    .Shapes(xNmbr).ConvertToInlineShape
    .Shapes(xNmbr).Ungroup
    Next
    End With
End Sub

Кто-нибудь знает, что здесь происходит? Я знаю, что здесь есть еще один вопрос, который спрашивает об одном и том же сообщении об ошибке, но они работают с фигурами, которые не являются текстовыми, поэтому их решение не работает для меня.

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

https://www.dropbox.com/s/z6ovashu3qv43i9/Fake%20Book.docx?dl=0

Заранее спасибо!

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

Sub Ungroup()
    Dim xNmbr As Integer
    With ActiveDocument
    For xNmbr = .Shapes.Count To 1 Step -1
        .Shapes(xNmbr).Select
        Set thisshape = .Shapes(xNmbr)
    With thisshape.WrapFormat
        .Type = wdWrapSquare
    End With
Next
End With

Dim mydocument As Document
    Set mydocument = ActiveDocument
    Dim shp As Shape
    For Each shp In mydocument.Shapes
        If shp.Type = msoGroup Then shp.Ungroup
    Next shp
End Sub

1 Ответ

0 голосов
/ 03 июля 2018

Финальное обновление: у меня все заработало! Я не знаю, что вызвало проблему, но просто проанализировав код, некоторые получили, что он работает правильно. 

Sub Ungroup()
Dim xNmbr As Integer
With ActiveDocument
    For xNmbr = .Shapes.Count To 1 Step -1
    .Shapes(xNmbr).Select
        Set thisshape = .Shapes(xNmbr)
        With thisshape.WrapFormat
       .Type = wdWrapSquare
    If thisshape.Type = msoGroup Then thisshape.Ungroup
    End With
    Next
End With
End Sub
...