Esta macro inserta en un libro de OpenOffice Calc una macro, una imagen y un texto en la primera hoja, y asigna la macro a la imagen, de forma completamente automatizada.

Con pequeñas adaptaciones puede ser utilizada para generar macros personalizadas para un grupo de documentos, como por ejemplo, exámenes, plantillas de grupos de trabajo, etc., insertando las macros en documentos existentes o en nuevos documentos.

Ha sido probada también en LibreOffice Calc.

La macro precisa los siguientes argumentos:

• cRutaNomDoc: Texto, indica la ruta y nombre del libro de Calc a editar.
• cRutaNomImg: Texto, indica la ruta y nombre de la imagen a insertar en el libro.
• cNomLibreria: Texto, indica el nombre de la librería que se creará en el libro de Calc.
• cNomModulo: Texto, indica el nombre del módulo que se creará en la librería anteriormente mencionada.
• cNomMacro: Texto, indica el nombre de la sub o function creada; debe cumplir las normas de nombres de Ooo Basic.
• nSubFunc: Entero, indica si se creará una Sub (si se le pasa un 1) o una Function (si se le pasa cualquier otro valor).
• cMacro: Texto, es la macro que se insertará en el libro de Calc.
• cTexto: Texto, el texto que se insertará en la primera hoja del libro de Calc.

La macro realiza las siguientes acciones:

1. Abre el libro de Calc en la ruta y con el nombre indicado. Si no existe, dará error.
2. Crea en el libro (o utiliza si ya existe) una biblioteca de macros con el nombre indicado, o si no se indica, utiliza el nombre por defecto Standard.
3. Crea en la biblioteca de macros un módulo con el nombre indicado, o si no se indica, utiliza el nombre por defecto Module1.
4. Crea en el módulo una macro (Sub o Function) según se indique en cSubFunc, y con el nombre indicado en cNomMacro.
5. Insertará la imagen indicada en la primera hoja del libro de Calc. Si no existe, dará error. La imagen debe tener un formato aceptado por Calc (png, jpg, bmp, etc.)
6. La imagen se inserta en tamaño 2 cm de alto por 2 cm de ancho, distante 1 cm del borde superior y 1 cm del borde izquierdo de la hoja.
7. Se asigna la macro a la imagen
8. Se inserta un texto en la primera hoja del libro de Calc.
9. Guarda y cierra el documento

 

La macro:

Sub Calc_InsertarMacro( cRutaNomDoc As String, cRutaNomImg As String, _
  cNomLibreria As String, cNomModulo As String, cNomMacro As String, _
  nSubFunc As Integer, cMacro As String, cTexto as string )
  ' Inserta una macro en un documento de Calc, inserta una imagen,
  ' y asigna la macro a la imagen
  ' cSubFunc es Sub o Function
  ' cNomLibreria y cNomModulo pueden pasarse vacías
  Dim cURL As String, Lf As String, cSubFunc As String, oCelda As Object
  Dim oDoc As Object, xBasicLibrerias As Object, oNuevaLibreria As Object
  Dim oImg As Object, oSize As New com.sun.star.awt.Size, oPos As New com.sun.star.awt.Point

  On Error GoTo Error_Calc_InsertarMacro

  Lf = Chr(13)

  ' Valores por defecto
  If cNomLibreria="" Then cNomLibreria="Standard"
  If cNomModulo="" Then cNomModulo="Module1"
  cSubFunc = IIf( nSubFunc = 1, "Sub", "Function")
  If cTexto="" Then cTexto="Haz clic sobre la imagen para ejecutar la macro"

  ' Abrir el libro de Calc
  cURL = ConvertToURL(cRutaNomDoc)
  Dim xPropertyValue1(0) As New com.sun.star.beans.PropertyValue
  xPropertyValue1(0).Name = "MacroExecutionMode"
  xPropertyValue1(0).Value = com.sun.star.document.MacroExecMode.USE_CONFIG
  oDoc = StarDesktop.loadComponentFromURL(cURL, "_blank",0, xPropertyValue1)

  ' Preparar la macro
  cMacro = cSubFunc & " " & cNomMacro & "()" & Lf & _
  cMacro & Lf & "End " & cSubFunc

  ' Insertar la macro
  xBasicLibrerias = oDoc.BasicLibraries
  If xBasicLibrerias.hasByName(cNomLibreria) Then
    xBasicLibrerias.loadLibrary(cNomLibreria)
    oNuevaLibreria = xBasicLibrerias.getByName(cNomLibreria)
  Else
    oNuevaLibreria = xBasicLibrerias.createLibrary(cNomLibreria)
  End If	
  oNuevaLibreria.insertByName(cNomModulo, cMacro)

  ' Preparar la imagen
  cURL = ConvertToURL(cRutaNomImg)
  ' Para que no se inserte vinculada
  oImg = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
  oImg.insertByName( "Imagen_Macro", cURL )
  cURL = oImg.getByName( "Imagen_Macro" )
  ' Inserto la imagen embebida
  oImg = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
  oImg.GraphicURL = cURL
  oSize = oImg.Size
  oSize.Height = 2000 ' altura = cm*1000
  oSize.Width = 2000
  oImg.Size = oSize
  oPos = oImg.Position
  oPos.X = 1000       ' posición = cm*1000
  oPos.Y = 1000
  oImg.Position = oPos
  oDoc.DrawPages.getByIndex(0).add(oImg)

  ' Asignar la macro a la imagen
  Dim xPropertyValue2(1) As New com.sun.star.beans.PropertyValue
  xPropertyValue2(0).Name = "EventType"
  xPropertyValue2(0).Value = "Script"
  xPropertyValue2(1).Name = "Script"
  xPropertyValue2(1).Value = "vnd.sun.star.script:" & _
  cNomLibreria & "." & cNomModulo & "." & _
  cNomMacro & "?language=Basic&location=document"

  ' Asignar evento OnClick a la imagen
  oImg.Events.replaceByName("OnClick", xPropertyValue2())

  ' Escribo algo en una celda para que pueda guardar cambios
  ' si no lo hago, no detecta cambios y no guarda la imagen !!!!!
  oCelda = oDoc.Sheets(0).getCellRangeByName("C4")
  oCelda.setString(cTexto)
  oDoc.store()
  oDoc.Close(True)

  MsgBox "Proceso terminado", 192, "Macro Calc_InsertarMacro"

  Exit Sub

Error_Calc_InsertarMacro:
  Beep
  MsgBox "Se ha producido un error " & Err & " en la macro Calc_InsertarMacro" & _
  Lf & Error , 144, "Macro Calc_InsertarMacro"
  On Error GoTo 0

End Sub

 

Ejemplo de uso

 

Sub Main
  Dim cMacro As String
  Dim Lf As String

  Lf = Chr(13)

  cMacro = "' Esta macro ha sido insertada desde otra macro" & Lf
  cMacro = cMacro & "  Dim cTitulo As String, cMsg As String" & Lf
  cMacro = cMacro & "  cTitulo=""Insertar Macro""" & Lf
  cMacro = cMacro & "  cMsg=""Esta macro ha sido insertada desde otra macro""" & Lf
  cMacro = cMacro & "  Beep" & Lf
  cMacro = cMacro & "  MsgBox cMsg, 192, cTitulo"

  Calc_InsertarMacro "X:\Mis Docs\Libro de Calc.ods", "X:\Mis Docs\imagen.png", "", "", "Mi_Sub", 1, cMacro, ""
End Sub

 

Fuente: Basada en este mensaje del Foro Oficial de Apache OpenOffice, la macro ha sido modificada y en algunos aspectos mejorada.