Создать макросом кнопку и повесить на нее другой макрос

[dimmon777]

День добрый! Помогите создать кнопку на листе, и самое главное, в событиях кнопки указать выполнение иного макроса, т.е. по нажатию на кнопку, выполнялся назначенный макрос...
На др. форуме нашел примерно след код:

Sub CreateButton
  oDoc = ThisComponent
  oSheet = oDoc.Sheets.getByIndex(0)
  oDrawPage = oSheet.DrawPage

  sScriptURL = "vnd.sun.star.script:Standard.Module1.ButtonPushEvent?language=Basic&location=document"
  oButtonModel = AddNewButton("Печать в 2х экз.", "Печать в 2х экз", oDoc, oDrawPage)
  oForm = oDrawPage.getForms().getByIndex(0)

End Sub

Function AddNewButton(sName As String, sLabel As String, oDoc As Object, oDrawPage As Object) As Object
  oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
 
  aPoint = CreateUnoStruct("com.sun.star.awt.Point")
  aSize = CreateUnoStruct("com.sun.star.awt.Size")
  aPoint.X = 4000
  aPoint.Y = 1000
  aSize.Width = 3000
  aSize.Height = 700
  oControlShape.setPosition(aPoint)
  oControlShape.setSize(aSize)

  oButtonModel = CreateUnoService("com.sun.star.form.component.CommandButton")
  oButtonModel.Name = sName
  oButtonModel.Label = sLabel

  oControlShape.setControl(oButtonModel)
  oDrawPage.add(oControlShape)

  AddNewButton = oButtonModel

End Function

Заранее благодарен, если вышеизложенный код будет оптимизирован (т.к. "выдран" из др. задачи)

[rami]

Заранее благодарен, если вышеизложенный код будет оптимизирован (т.к. "выдран" из др. задачи)

А что значит "будет оптимизирован"? Код неполный потому, что "зверски выдран" , аккуратней надо выдирать.

Вот работающий код:

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

Sub CreateButton
  oDoc = ThisComponent
  oDrawPage = oDoc.getDrawPages().getByIndex(0)
  sScriptURL = "vnd.sun.star.script:Standard.Module1.ButtonPushEvent?language=Basic&location=document"
  oButtonModel = AddNewButton("Печать в 2х экз", "Печать в 2х экз", oDoc, oDrawPage)
  oForm = oDrawPage.getForms().getByIndex(0)
  nIndex = GetIndex(oButtonModel, oForm)
  AssignAction(nIndex, sScriptURL, oForm)
End Sub

Sub AssignAction(nIndex As Integer, sScriptURL As String, oForm As Object)
  aEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor")
  With aEvent
    .AddListenerParam = ""
    .EventMethod = "actionPerformed"
    .ListenerType = "XActionListener"
    .ScriptCode = sScriptURL
    .ScriptType = "Script"
  End With
  oForm.registerScriptEvent(nIndex, aEvent)
End Sub

Function AddNewButton(sName As String, sLabel As String, oDoc As Object, oDrawPage As Object) As Object
  oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
  aPoint = CreateUnoStruct("com.sun.star.awt.Point")
  aSize = CreateUnoStruct("com.sun.star.awt.Size")
  aPoint.X = 1000
  aPoint.Y = 1000
  aSize.Width = 3000
  aSize.Height = 1000
  oControlShape.setPosition(aPoint)
  oControlShape.setSize(aSize)
  oButtonModel = CreateUnoService("com.sun.star.form.component.CommandButton")
  oButtonModel.Name = sName
  oButtonModel.Label = sLabel
  oControlShape.setControl(oButtonModel)
  oDrawPage.add(oControlShape)
  AddNewButton = oButtonModel
End Function

Function GetIndex(oControl As Object, oForm As Object) As Integer
  Dim nIndex As Integer
  nIndex = -1
  For i = 0 To oForm.getCount() - 1 step 1
    If EqualUnoObjects(oControl, oForm.getByIndex(i)) Then
      nIndex = i
      Exit For
    End If
  Next
  GetIndex = nIndex
End Function

Sub ButtonPushEvent(ev as com.sun.star.awt.ActionEvent)
msgbox ev.Source.Model.Name
End Sub

[dimmon777]

rami

Спасибо за ответ!

А что значит "будет оптимизирован"?

Под этим я предположил, что можно ли код уменьшить ?  Что будет если захочу сделать не одну кнопку а три-пять, да еще и радиокнопки?

[rami]

Под этим я предположил, что можно ли код уменьшить ?  Что будет если захочу сделать не одну кнопку а три-пять, да еще и радиокнопки?

Для одной-двух кнопок не стоит, а если больше, то установку свойств можно вынести в отдельные функции. А зачем нужно создавать кнопки макросом? Может быть подойдут другие варианты решения.