Здравствуйте!
Не могу понять, как вставлять в Shape в нужную ячейку таблицы. Толи нужно переносить anchor моего прямоугольника в ячейку таблицы, толи нужно устанавливать курсор в ячейку перед созданием фигуры? Не получается никак.
Пример кода:
Макрос
Sub Макрос1()
Dim docNew As Document
Dim shpCanvas As Shape
Dim tblNew As Table
' Создаю документ
Set docNew = Documents.Add
' Формирую вид
docNew.Paragraphs.Alignment = wdAlignParagraphCenter
With docNew.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(1.27)
.BottomMargin = CentimetersToPoints(1.27)
.LeftMargin = CentimetersToPoints(1.27)
.RightMargin = CentimetersToPoints(1.27)
.VerticalAlignment = wdAlignVerticalCenter
End With
' Создаю таблицу
Set tblNew = docNew.Tables.Add(Selection.Range, 2, 1)
' Создаю прямоугольник, пытаюсь сделать это в ячейке
tblNew.Cell(1, 1).Range.Select
Set shpCanvas = docNew.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100)
' Set shpCanvas = docNew.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100, tblNew.Cell(1,1).Range)
' Задаю формат обтекания текстом
shpCanvas.WrapFormat.Type = wdWrapSquare
End Sub
В итоге у меня всегда прямоугольник под таблицей, а не в ячейке. Моих куцых знаний не хватает, и на киберфоруме не отвечают. Может быть здесь кто-то знает правильное решение?
Какая у вас версия Ворда: 2007, 2010 и т.д?
В Офисе 365 ваш макрос вставляет Shape внутрь ячейки.
o_O
Пишет Микрософт Офис Плюс Профессиональный 2016!
Сейчас на другой машине проверю
Да, Вы правы!
В более поздних версиях офиса все работает. Спасибо!
Никогда бы не подумал, что проблема в этом
Иногда помогает установка обновлений.
После установки Офиса, сразу устанавливайте обновления.
Если после установки обновлений проблема в Офисе 2016 осталась, то можно подумать, как перемещать Shape в таблицу после вставки.
Да, давайте попробуем найти возможность перемещать фигуру. Это позволит сделать код более универсальным, чтобы он работал и со старыми версиями Ворда.
Нужно как-то переместить anchor
А обновления вы установили в Офисе 2016?
Нет. Это чужой сервер. Долго объяснять админу зачем мне это нужно, если и так "все работает". Хотелось бы найти универсальный способ, чтобы макрос правильно отрабатывал даже на необновленных платформах. Поэтому хочу узнать, как правильно перемещать anchor
В общем, нашел решение. В новых версиях Офиса изначальный код работает нормально, а в старых сработал такой костыль:
1)Вырезать anchor у Shape
2)Выбрать нужную ячейку таблицы
3)Выполнить вставку
Sub Макрос1()
Dim docNew As Document
Dim shpCanvas As Shape
Dim tblNew As Table
' Создаю документ
Set docNew = Documents.Add
' Формирую вид
docNew.Paragraphs.Alignment = wdAlignParagraphCenter
With docNew.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(1.27)
.BottomMargin = CentimetersToPoints(1.27)
.LeftMargin = CentimetersToPoints(1.27)
.RightMargin = CentimetersToPoints(1.27)
.VerticalAlignment = wdAlignVerticalCenter
End With
' Создаю таблицу
Set tblNew = docNew.Tables.Add(Selection.Range, 2, 1)
' Создаю прямоугольник, пытаюсь сделать это в ячейке
tblNew.Cell(1, 1).Range.Select
Set shpCanvas = docNew.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100)
' Set shpCanvas = docNew.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100, tblNew.Cell(1,1).Range)
' Задаю формат обтекания текстом
shpCanvas.WrapFormat.Type = wdWrapSquare
' Код, который перенесет anchor в нужную ячейку, если это не произошло автоматически в старых версиях Word
shpCanvas.Anchor.Cut
tblNew.Cell(1, 1).Range.Select
Selection.Paste
End Sub