Группу создать в ячейке 1,1 первой таблицы

[Ципихович Эндрю]

здравствуйте, макрос рабочий

Код Выделить Развернуть

Sub CreateGroupWithButtonsInCell()
    Dim oDoc As Object
    Dim oDrawPage As Object
    Dim oGroupShape As Object
    Dim oButtonShape As Object
    Dim oTable As Object
    Dim oCell As Object
    Dim oCellText As Object
    Dim oCursor As Object
    Dim labels(10) As String
    Dim i As Integer
   
    labels = Array("-5", "-4", "-3", "-2", "-1", "<0>", "+1", "+2", "+3", "+4", "+5")
   
    oDoc = ThisComponent
   
    ' Получаем первую таблицу
    oTable = oDoc.getTextTables().getByIndex(0)
   
    ' Получаем ячейку A1 (строка 0, колонка 0)
    oCell = oTable.getCellByPosition(0, 0)
    oCellText = oCell.getText()
    oCursor = oCellText.createTextCursor()
   
    ' Создаём GroupShape
    oGroupShape = oDoc.createInstance("com.sun.star.drawing.GroupShape")
   
    Dim oGroupPos As New com.sun.star.awt.Point
    oGroupPos.X = 1000
    oGroupPos.Y = 1000
    oGroupShape.setPosition(oGroupPos)
   
    Dim oGroupSize As New com.sun.star.awt.Size
    oGroupSize.Width = 10000
    oGroupSize.Height = 3000
    oGroupShape.setSize(oGroupSize)
   
    ' Привязываем как символ к тексту ячейки
    oGroupShape.setPropertyValue("AnchorType", com.sun.star.text.TextContentAnchorType.AS_CHARACTER)
   
    ' Вставляем группу в ячейку
    oCellText.insertTextContent(oCursor, oGroupShape, False)
   
    ' Создаём кнопки внутри группы
    Dim btnWidth As Long: btnWidth = 800
    Dim btnHeight As Long: btnHeight = 400
    Dim startX As Long: startX = 500
    Dim startY As Long: startY = 1200
    Dim spacing As Long: spacing = 100
    Dim currentX As Long: currentX = startX
   
    For i = 0 To 10
        oButtonShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
       
        Dim oButtonModel As Object
        oButtonModel = oDoc.createInstance("com.sun.star.form.component.CommandButton")
        oButtonModel.Name = "Btn" & i
        oButtonModel.Label = labels(i)
        oButtonShape.setControl(oButtonModel)
       
        Dim oBtnPos As New com.sun.star.awt.Point
        oBtnPos.X = currentX
        oBtnPos.Y = startY
        oButtonShape.setPosition(oBtnPos)
       
        Dim oBtnSize As New com.sun.star.awt.Size
        oBtnSize.Width = btnWidth
        oBtnSize.Height = btnHeight
        oButtonShape.setSize(oBtnSize)
       
        oGroupShape.add(oButtonShape)
       
        currentX = currentX + btnWidth + spacing
    Next i
   
    MsgBox "Готово! Группа добавлена в ячейку A1."
End Subно группа создаётся не так как нужно в ячейке под углом 45 градусов, но нужно создать группу в одну линию, как поправить?

[sokol92]

У меня работает в следующей редакции.
Последовательность действий:
1. Создаем кнопки и добавляем их в ShapeCollection
2. Выделяем ShapeCollection и группируем с помощью ".uno:FormatGroup"

UPDATE.
1. Добавил установку FormDesignMode в True.

Код Выделить Развернуть

Option Explicit

Sub CreateGroupWithButtonsInCell()
    Dim oDoc As Object
    Dim oController as Object
    Dim oDispatcher as Object
    Dim oDrawPage As Object
    Dim oShapeCollection As Object
    Dim oButtonShape As Object
    Dim oTable As Object
    Dim oCell As Object
    Dim oCellText As Object
    Dim oCursor As Object
    Dim labels(10) As String
    Dim i As Integer
   
    labels = Array("-5", "-4", "-3", "-2", "-1", "<0>", "+1", "+2", "+3", "+4", "+5")
   
    oDoc = ThisComponent
    oController = oDoc.CurrentController
    oController.setFormDesignMode(True)
   
    ' Получаем первую таблицу
    oTable = oDoc.getTextTables().getByIndex(0)
   
    ' Получаем ячейку A1 (строка 0, колонка 0)
    oCell = oTable.getCellByPosition(0, 0)
   
    oCellText = oCell.getText()
    oCursor = oCellText.createTextCursor()
 
    oShapeCollection = CreateUnoService("com.sun.star.drawing.ShapeCollection")
   
    ' Создаём кнопки для группы
    Dim btnWidth As Long: btnWidth = 800
    Dim btnHeight As Long: btnHeight = 400
    Dim startX As Long: startX = 500
    Dim startY As Long: startY = 1200
    Dim spacing As Long: spacing = 100
    Dim currentX As Long: currentX = startX
   
    For i = 0 To 10
        oButtonShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
       
        Dim oButtonModel As Object
        oButtonModel = oDoc.createInstance("com.sun.star.form.component.CommandButton")
        oButtonModel.Name = "Btn" & i
        oButtonModel.Label = labels(i)
        oButtonShape.setControl(oButtonModel)
       
        Dim oBtnPos As New com.sun.star.awt.Point
        oBtnPos.X = currentX
        oBtnPos.Y = startY
        oButtonShape.setPosition(oBtnPos)
       
        Dim oBtnSize As New com.sun.star.awt.Size
        oBtnSize.Width = btnWidth
        oBtnSize.Height = btnHeight
        oButtonShape.setSize(oBtnSize)
        oButtonShape.AnchorType =  com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
       
        oCellText.insertTextContent(oCursor, oButtonShape, False)
        oShapeCollection.Add(oButtonShape)
        'oGroupShape.add(oButtonShape)
       
        currentX = currentX + btnWidth + spacing
    Next i
   
    oController.select(oShapeCollection)
   
    Wait 300
    oDispatcher = CreateUnoService("com.sun.star.frame.DispatchHelper")
    oDispatcher.executeDispatch(oController.Frame, ".uno:FormatGroup", "", 0, Array())
   
    MsgBox "Готово! Группа добавлена в ячейку A1."
End Sub

[Ципихович Эндрю]

Готово! Группа добавлена в ячейку A1.

спасибо, аккурат под таблицей вставляет, как поправить?

[bigor]

как поправить?

если привязку AT_PARAGRAPH заменить на AS_CHARACTER, то вставляет в ячейку, но нужен контроль ширины ячейки, иначе в в 2 строки вставит

[Ципихович Эндрю]

если привязку AT_PARAGRAPH заменить на AS_CHARACTER, то вставляет в ячейку, но нужен контроль ширины ячейки, иначе в в 2 строки вставит

понял, спасибо

[sokol92]

спасибо, аккурат под таблицей вставляет, как поправить?

1. Вы изменили в моем макросе строку:

Код Выделить Развернуть

oController.setFormDesignMode(True)
на строку с противоположным действием.

2. У Вас значение переменной startY равно 1200. Замените на 0 и вставка будет выровнена по верхнему краю ячейки A1.

3. Группировка ячеек отрабатывает корректно при непосредственном вызове макроса или при вызове через кпопку на инструментальной панели (см. вложение).

При вызове макроса из поля документа (типа "Выполнить макрос") группировка ячеек не производится (причина мне неизвестна).

[Ципихович Эндрю]

sokol92, спасибо, ознакомился, было напутано с порядком строка-колонка, колонка-строка, мелочи жизни, но исправил))
подскажите в прилагаемом файле кнопку "Дата составления" как сделать по ширине текста
от чего зависит, что у этой кнопки есть подсказка "Дата составления" а у остальных нет-догадка моя, потому, что весь текст не поместился - поэтому и подсказка
впервые сталкиваюсь с этим контролом, поэтому можно ещё инфы о нём
хотел сделать как бы подложку\форму а на ней кнопки, то есть чтобы это был монолит, можно сделать?
"Дата составления" можно сделать НЕ кнопкой, лейблом?
смысл в том, что в документе получится самодельный контрол
спасибо

[bigor]

"Дата составления" как сделать по ширине текста

можно так:

[Ципихович Эндрю]

bigor, понял, спасибо, по остальным вопросам не подскажите?