Trabajando con elementos gráficos

Esta página está en estado borrador.

Poco a poco se ha ido diluyendo la frontera entre aplicaciones, es decir, entre un procesador de textos y una hoja de calculo por ejemplo, en uno y en otro podemos hacer muchas tareas similares, soy de la opinión de seguir usando cada aplicación especifica para la tarea que fue diseñada, no obstante, podemos hacer uso de esas características extras, tan variadas y ricas con que cuentan las aplicaciones actuales, lo cual aprenderemos en este capitulo.

Trabajando con imágenes

Calc, soporta la inclusión de una amplia variedad de formatos de imágenes, en el siguiente ejemplo, insertamos una imagen PGN en la hoja activa.

 Sub Imagenes1()
 Dim oDoc As Object
 Dim oPaginaDibujo As Object
 Dim oImagen As Object
 Dim sRuta As String
 Dim oTam As New com.sun.star.awt.Size
 
     'La ruta de la imagen
     sRuta = ConvertToURL("/home/mau/globo.png")
     oDoc = ThisComponent
     'Pagina de dibujo de la hoja activa
     oPaginaDibujo = oDoc.getCurrentController.getActiveSheet.getDrawPage()    
     'Para crear y manipular imagenes
     oImagen = oDoc.createInstance( "com.sun.star.drawing.GraphicObjectShape" )     
     'Establecemos la ruta de la imagen
     oImagen.GraphicURL = sRuta
     'La agregamos a la página de dibujo, por ende, al conjunto de formas
     oPaginaDibujo.add( oImagen )
     'Establecemos el tamaño de la imagen, siempre establece un tamaño, si no
     'se insertará con un tamaño mínimo casi invisible
     'la unidad es centésimas de milímetro
     oTam.Width = 10000
     oTam.Height = 7500
     oImagen.setSize( oTam )
 
 End Sub

Ahora permitimos al usuario seleccionar una imagen, el método para abrir un archivo lo usamos casi al principio de estos apuntes, pero aquí lo recordamos.

 Sub Imagenes2()
 Dim oDlgAbrirArchivo As Object
 Dim mArchivo()
 Dim sRuta As String
 Dim oPaginaDibujo As Object
 Dim oImagen As Object
 Dim oTam As New com.sun.star.awt.Size
 
     'Creamos el servicio necesario
     oDlgAbrirArchivo = CreateUnoService ("com.sun.star.ui.dialogs.FilePicker")
     'Establecemos los filtros de archivo
     oDlgAbrirArchivo.appendFilter( "Todos los formatos", "*.png;*.jpg;*.jpge;*.bmp;*.tiff")
     oDlgAbrirArchivo.appendFilter( "Imagenes PNG", "*.png")
     oDlgAbrirArchivo.appendFilter( "Imagenes JPG", "*.jpg")
     'Establecemos el titulo del cuadro de dialogo
     oDlgAbrirArchivo.setTitle("Selecciona la imagen")
     'Con el metodo .Execute() mostramos el cuadro de dialogo
     'Si el usuario presiona Abrir el metodo devuelve 1 que podemos evaluar como Verdadero (True)
     'Si presiona Cancelar devuelve 0
     If oDlgAbrirArchivo.Execute() Then
         'De forma predeterminada, solo se puede seleccionar un archivo
         'pero devuelve una matriz de todos modos con la ruta completa
         'del archivo en formato URL
         mArchivo() = oDlgAbrirArchivo.getFiles()
         'El primer elemento de la matriz es el archivo seleccionado
         sRuta = mArchivo(0)
         'Insertamos la imagen
         oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()    
         oImagen = ThisComponent.createInstance( "com.sun.star.drawing.GraphicObjectShape" )     
         oImagen.GraphicURL = sRuta
         oPaginaDibujo.add( oImagen )
         oTam.Width = 10000
         oTam.Height = 7500
         oImagen.setSize( oTam )
     Else
         'Si el usuario presiona Cancelar
         MsgBox "Proceso cancelado"
     End If
 
 End Sub

El método para abrir archivos, podrías convertirla en una función para que te devuelva el nombre o nombres de los archivos abiertos, aquí te muestro una primer forma que nos servirá para nuestros siguientes ejemplos, pero tu puedes mejorarla, por ejemplo, pasándole el título del dialogo y los filtros que soporte.

 'Función para devolver la imagen a insertar
 Function SelecionarImagen() As String
 Dim oDlgAbrirArchivo As Object
 Dim mArchivos()
 
     oDlgAbrirArchivo = CreateUnoService ("com.sun.star.ui.dialogs.FilePicker")
     oDlgAbrirArchivo.appendFilter( "Todos los formatos de imagen", "*.png;*.jpg;*.jpge;*.bmp;*.tiff")
     oDlgAbrirArchivo.appendFilter( "Imagenes PNG", "*.png")
     oDlgAbrirArchivo.appendFilter( "Imagenes JPG", "*.jpg")
     oDlgAbrirArchivo.setTitle("Selecciona la imagen a insertar")
     If oDlgAbrirArchivo.Execute() Then
         mArchivos() = oDlgAbrirArchivo.getFiles()
         SelecionarImagen = mArchivos(0)
     End If
 
 End Function

Comprueba que funciona como se espera.

 Sub Imagenes3()
 Dim sRuta As String
 
     sRuta = SelecionarImagen()
     MsgBox sRuta
 
 End Sub

La siguiente subrutina, inserta la imagen pasada como argumento en la hoja activa, puedes mejorarla pasándole la hoja donde se insertará, la posición y el tamaño, por ahora, para nuestro ejemplo, así nos sirve.

'Subrutina para insertar la imagen en la hoja activa
 
 Sub InsertaImagen(RutaImagen As String)
 Dim oDoc As Object
 Dim oPaginaDibujo As Object
 Dim oImagen As Object
 Dim oTam As New com.sun.star.awt.Size
 
     oDoc = ThisComponent
     oPaginaDibujo = oDoc.getCurrentController.getActiveSheet.getDrawPage()    
     oImagen = oDoc.createInstance( "com.sun.star.drawing.GraphicObjectShape" )     
     oImagen.GraphicURL = RutaImagen
     oPaginaDibujo.add( oImagen )
     oTam.Width = 10000
     oTam.Height = 7500
     oImagen.setSize( oTam )
 
 End Sub

Y la probamos.

 Sub Imagenes4()
 Dim sRuta As String
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         Call InsertarImagen( sRuta )
     End If
 
 End Sub

La subrutina la puedes convertir en función y devolver una referencia a la imagen insertada, de este modo, puedes seguir manipulándola. Nota que en la función no establecemos el tamaño de la imagen, por lo que es importante que lo hagas después de llamar a esta función.

 'Función para insertar la imagen en la hoja activa, devuelve la imagen
 'nota que no establecemos el tamaño
 Function getImagen(RutaImagen As String) As Object
 Dim oDoc As Object
 Dim oPaginaDibujo As Object
 Dim oImagen As Object
 
     oDoc = ThisComponent
     oPaginaDibujo = oDoc.getCurrentController.getActiveSheet.getDrawPage()    
     oImagen = oDoc.createInstance( "com.sun.star.drawing.GraphicObjectShape" )     
     oImagen.GraphicURL = RutaImagen
     oPaginaDibujo.add( oImagen )
     getImagen = oImagen
 
 End Function

Y la prueba.

 Sub Imagenes5()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oTam As New com.sun.star.awt.Size
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         oImagen = getImagen( sRuta )
         oTam.Width = 10000
         oTam.Height = 7500
         oImagen.setSize( oTam )
     End If
 
 End Sub

Y ya lanzados, crea la subrutina para establecer el tamaño, que servirá para cualquier objeto que soporte estas propiedades.

 Sub CambiaTam( Obj As Object, Ancho As Long, Alto As Long )
 Dim oTam As New com.sun.star.awt.Size
 
     oTam.Width = Ancho
     oTam.Height = Alto
     Obj.setSize( oTam )
 
 End Sub

Hasta ahora, las imágenes insertadas, siempre lo hacen ancladas (Anchor) a la celda A1, vamos a cambiar esto y por consiguiente la posición de la imagen.

 Sub Imagenes6()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oCelda As Object
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 10000, 7500 )
         'Establecemos la celda de anclaje, al modificar esta se modifica la posición
         oCelda = ThisComponent.getCurrentController.getActiveSheet.getCellByPosition( 4,9 )
         oImagen.Anchor = oCelda    
     End If
 
 End Sub

El ancla también la puedes establecer a la hoja.

 Sub Imagenes7()
 Dim sRuta As String
 Dim oImagen As Object
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 10000, 7500 )
         'Establecemos la hoja como ancla
         oImagen.Anchor = ThisComponent.getCurrentController.getActiveSheet
     End If
 
 End Sub

Como ya lo comprobamos, si cambias el ancla de la imagen a una celda, la imagen cambia a la posición de dicha celda, pero también puedes establecer esta posición, no importando si el ancla esta a la hoja o a una celda.

 Sub Imagenes8()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oPos As New com.sun.star.awt.Point
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 10000, 7500 )
         'Establecemos la posición de la imagen
         oPos.X = 15000
         oPos.y = 5000
         oImagen.setPosition( oPos )
     End If
 
 End Sub

Algunas propiedades interesantes; cuando insertas o eliminas filas o columnas, la imagen se verá afectada en su tamaño, puedes evitarlo protegiendo su tamaño (SizeProtect), también puedes evitar que se mueva (MoveProtect) y que se imprima (Printable).

 Sub Imagenes9()
 Dim sRuta As String
 Dim oImagen As Object
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 10000, 7500 )
 
         With oImagen
             'Nombramos la imagen
             .Name = "Imagen09"
             'Evitamos que la muevan
             .MoveProtect = True
             'Que cambie su tamaño
             .SizeProtect = True
             'Que se imprima
             .Printable = False
             'Puedes reflejar la imagen
             .IsMirrored = True
         End With
     End If
 
 End Sub

El nombre asignado a la imagen (Name), es el que puede establecer con el menú contextual de la imagen, así mismo, es el nombre que aparecerá en el navegador, es importante que lo asignes, sobre todo si manejas muchas imágenes para que se muestre en el navegador.

Puedes tener varias imágenes con el mismo nombre. A las imágenes, les puedes cambiar el modo de color (GraphicColorMode), según la siguiente enumeración.

com.sun.star.drawing.ColorMode	Valor	Valor en Interfaz
com.sun.star.drawing.ColorMode.STANDARD	0	Predeterminado
com.sun.star.drawing.ColorMode.GREYS	1	Escala de grises
com.sun.star.drawing.ColorMode.MONO	2	Blanco y negro
com.sun.star.drawing.ColorMode.WATERMARK	3	Filigrana

El siguiente ejemplo, inserta la imagen varias veces son los diferentes modos.

 Sub Imagenes10()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oPos As New com.sun.star.awt.Point
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         'Insertamos la imagen normal
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
 
         'Insertamos la misma imagen
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 5000, 0 )
         'Cambiamos el modo de color a escala de grises
         oImagen.GraphicColorMode = com.sun.star.drawing.ColorMode.GREYS
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 10000, 0 )
         'Cambiamos el modo de color a blanco y negro
         oImagen.GraphicColorMode = com.sun.star.drawing.ColorMode.MONO
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 15000, 0 )
         'Cambiamos el modo de color a marca de agua
         oImagen.GraphicColorMode = com.sun.star.drawing.ColorMode.WATERMARK
 
     End If
 
 End Sub
 
 
 'Cambia la posición del objeto
 Sub CambiaPos( Obj As Object, X As Long, Y As Long )
 Dim oPos As New com.sun.star.awt.Point
 
     oPos.X = X
     oPos.Y = Y
     Obj.setPosition( oPos )    
 End Sub

El resultado.

Puedes cambiar la transparencia (Transparency) de la imagen, este valor va de 0 a 100, donde 0 es el valor predeterminado, sin transparencia y 100 totalmente transparente, si estableces este valor en 100 y pierdes la selección, no veras la imagen por lo que procura no establecerlo tan alto.

 Sub Imagenes11()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oPos As New com.sun.star.awt.Point
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         'Insertamos la imagen normal
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 5000, 0 )
         'Cambiamos el nivel de transparencia
         oImagen.Transparency = 25
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 10000, 0 )
         oImagen.Transparency = 50
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 15000, 0 )
         oImagen.Transparency = 75    
 
     End If
 
 End Sub

Puedes manipular completamente los colores de una imagen (si sabes por que yo no), tanto la luminosidad (AdjustLuminance), como el contraste (AdjustContrast), el canal gamma (Gamma). La luminosidad y el contraste, toman valores de 0 a 100, el canal gamma, de 0.1 a 10.

 Sub Imagenes12()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oPos As New com.sun.star.awt.Point
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         'Insertamos la imagen normal
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 5000, 0 )
         'Cambiamos el nivel de luminosidad
         oImagen.AdjustLuminance = 50
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 10000, 0 )
         'Cambiamos el contraste
         oImagen.AdjustContrast = 50
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 15000, 0 )
         'Cambiamos el canal gamma, que no se que sea, pero cambia
         oImagen.Gamma = 5
 
     End If
 
 End Sub

Y por supuesto, también puedes cambiar los canales: rojo (AdjustRed), verde (AdjustGreen) y azul (AdjustBlue), de la siguiente manera.

 Sub Imagenes13()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oPos As New com.sun.star.awt.Point
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         'Insertamos la imagen normal
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 5000, 0 )
         'Cambiamos el nivel de rojo
         oImagen.AdjustRed = 50
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 10000, 0 )
         'Cambiamos el nivel de verde
         oImagen.AdjustGreen = 50
 
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 5000, 3750 )
         Call CambiaPos( oImagen, 15000, 0 )
         'Cambiamos el nivel de azul
         oImagen.AdjustBlue = 50
 
     End If
 
 End Sub

Mira que divertido queda.

Las imágenes insertadas tienen propiedades particulares, como las que hemos visto hasta ahora, pero al ser consideradas formas (shapes) comparten con ellas muchas de sus propiedades, por ejemplo, la posibilidad de agregarles texto, como en:

 Sub Imagenes14()
 Dim sRuta As String
 Dim oImagen As Object
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         oImagen = getImagen( sRuta )
         Call CambiaTam( oImagen, 10000, 7500 )
 
         'Insertamos texto en la imagen y le cambiamos sus propiedades
         With oImagen
             .String = "Apulco, Hidalgo" & Chr(13) & "México"
             .CharColor = RGB(255,255,255)
             .CharHeight = 30
             .CharWeight = 150
             .ParaAdjust = 3
         End With
 
     End If
 
 End Sub

Otras propiedades las veremos en el siguiente apartado, para terminar este tema, en todos los ejemplos anteriores, al insertar la imagen, la estás vinculando, por lo que si cambias el nombre de la imagen origen, la mueves o borras, cuando abras tu archivo, te quedará solo un marco vacío, para insertar la imagen incrustada en el documento, usa el siguiente código.

 Sub Imagenes15()
 Dim sRuta As String
 Dim oImagen As Object
 Dim oForma As Object
 Dim oGP As Object
 Dim mOpc(0) As New com.sun.star.beans.PropertyValue
 
     sRuta = SelecionarImagen()
     If sRuta <> "" Then
         'Agregamos una forma a la hoja activa
         oForma = ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape")
         ThisComponent.getCurrentController.getActiveSheet.getDrawPage().add(oForma)
         'Servicio para manipulacion de gráficos
         oGP = createUnoService("com.sun.star.graphic.GraphicProvider")
         'Establecemos la ruta
         mOpc(0).Name = "URL"
         mOpc(0).Value = sRuta
         'Trae la imagen y la carga en la forma
         oForma.Graphic = oGP.queryGraphic( mOpc )
         'Cambiamos el tamaño
         Call CambiaTam( oForma, 10000, 7500 )
     End If
 
 End Sub

El cual, por supuesto, puedes convertir en una función o subrutina para llamarla cuando quieras, pero esa, es tu tarea. El siguiente ejemplo es muy divertido, toma la selección y determina si es o no una imagen, solicita una ruta y nombre donde guardar y la guarda si el usuario no cancela la operación en formato “jpg”, puedes exportar a otros formatos diferentes.

 Sub Imagenes16()
 Dim sRuta As String
 Dim oSel As Object
 Dim oGP As Object
 Dim mOpc(1) As New com.sun.star.beans.PropertyValue
 
     'La selección actual
     oSel = ThisComponent.getCurrentController.getSelection        
     iF oSel.getImplementationName = "com.sun.star.drawing.SvxShapeCollection" Then
         'Si es una forma, siempre es la primera
         oSel = oSel.getByIndex(0)
         If oSel.supportsService("com.sun.star.drawing.GraphicObjectShape") Then
             'Si es una imagen, obtenemos la ruta y nombre para guardar
             sRuta = RutaGuardarImagen()
             If sRuta <> "" Then
                 oGP = createUnoService("com.sun.star.graphic.GraphicProvider")
                 'Establecemos las propiedades
                 mOpc(0).Name = "URL"
                 mOpc(0).Value = sRuta
                 mOpc(1).Name = "MimeType"
                 mOpc(1).Value = "image/jpeg"
                 'Guardamos la imagen
                 oGP.storeGraphic( oSel.Graphic, mOpc )
             Else
                 MsgBox "Proceso cancelado"
             End If
         Else
             MsgBox "La selección es una forma pero no una imagen"
         End If
     Else
         MsgBox "La selección no es una imagen"
     End If
 
 End Sub

La función para devolver la ruta es.

 'Función para devolver la ruta y nombre del archivo a guardar
 'Puedes mejorarla pasándole los filtros que quieras
 Function RutaGuardarImagen() As String
 Dim oDlgGuardarArchivo As Object
 Dim mArchivo() 
 Dim mDlgOpciones() 
 
     mDlgOpciones() = Array(2)
     oDlgGuardarArchivo = CreateUnoService ("com.sun.star.ui.dialogs.FilePicker")
     oDlgGuardarArchivo.setTitle("Guardar como")
     oDlgGuardarArchivo.Initialize ( mDlgOpciones() )
     oDlgGuardarArchivo.AppendFilter( "Imagen JPG (.jpg)", "*.jpg" )
     If oDlgGuardarArchivo.Execute() Then
         mArchivo() = oDlgGuardarArchivo.getFiles()
         RutaGuardarImagen = mArchivo(0)
     End If
 
 End Function

Y con esto terminamos el tema de imágenes, que puedes complementar perfectamente con los conocimientos de nuestro próximo apartado, pues muchas de las propiedades y métodos que veremos, son soportados por las imágenes.

Trabajando con autoformas

Con las herramientas de dibujo incluidas en la aplicación, se podría dibujar casi cualquier cosa, el limite, es tu imaginación, veamos, porqué. Cada hoja de nuestro archivo, tiene una “página de dibujo virtual” (DrawPage), donde están todos los elementos gráficos, para acceder a esta hoja, usamos.

 Sub AutoFormas1()
 Dim oDoc As Object
 Dim oHojaActiva As Object
 Dim oPaginaDibujo As Object
 
     oDoc = ThisComponent
     oHojaActiva = oDoc.getCurrentController.getActiveSheet()
     'Accedemos a la página de dibujo
     oPaginaDibujo = oHojaActiva.getDrawPage()
 
     'Mostramos el número de elementos en la página
     MsgBox oPaginaDibujo.getCount
 
 End Sub

La cuenta de los objetos gráficos incluye las notas de las celdas, por lo que si te muestra un número y aparentemente no hay nada en la hoja, tal vez este sea tu caso, otras veces, hay elementos como imágenes que tienen un tamaño mínimo y no se notan o están posicionadas en zonas de la hoja muy separadas. El siguiente ejemplo, cambia el tamaño y la posición de “todos” los objetos gráficos de la hoja y los posiciona en la esquina superior izquierda de la hoja, las subrutinas “CambiaTam” y “CambiaPos”, ya las hemos usado anteriormente.

 Sub AutoFormas2()
 Dim oDoc As Object
 Dim oHojaActiva As Object
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim co1 As Long
 
     oDoc = ThisComponent
     oHojaActiva = oDoc.getCurrentController.getActiveSheet()
     'Accedemos a la página de dibujo
     oPaginaDibujo = oHojaActiva.getDrawPage()
     'Iteramos en cada forma
     For co1 = 0 To oPaginaDibujo.getCount - 1
         oForma = oPaginaDibujo.getByIndex(co1)
         'Cambiamos su tamaño
         Call CambiaTam( oForma, 3000, 3000 )
         'Y su posición
         Call CambiaPos( oForma, 0, 0 )
     Next
 
 End Sub

Si en tu hoja hay notas, estas se cambiaran de tamaño pero el cambio de posición solo se verá reflejado cuando muestres la nota, no cuando pongas el cursor sobre la celda, que siempre muestra las notas cerca de esta, si no cuando la muestres permanentemente.

Para agregar una forma a la página de dibujo y por consiguiente a la hoja activa (puede ser a la hoja que quieras, no necesariamente la activa), primero creas una instancia de la forma que quieras, bueno, casi de la que quieras por que en las hojas de calculo no puedes agregar todos los tipos de formas, por ejemplo, una polilínea no puedes agregarla, lo cual si puedes hacer en Draw o Impress, entonces, después de agregar la forma soportada en Calc, le estableces sus propiedades y al final la agregas a la página de dibujo. Como con las imágenes, es importante que al menos cambies el tamaño de la nueva forma, si no, se creará del tamaño mínimo, la nueva forma se crea con las propiedades predeterminadas, las cuales, aprenderemos a cambiar aquí. En el siguiente ejemplo, agregamos un rectángulo a la hoja.

 Sub AutoFormas3()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Creamos un rectangulo
     oForma = ThisComponent.createInstance("com.sun.star.drawing.RectangleShape")
     Call CambiaTam( oForma, 5000, 3000 )
     oPaginaDibujo.add( oForma )
 
 End Sub

¿Adivina que pasa si estableces el mismo alto y ancho?, es obvia la respuesta, en vez de un rectángulo, tienes un cuadrado, lo mismo pasa con las elipses, si establece el mismo ancho y alto, obtienes un circulo.

 Sub AutoFormas4()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Creamos un circulo
     oForma = ThisComponent.createInstance("com.sun.star.drawing.EllipseShape")
     Call CambiaTam( oForma, 5000, 5000 )
     oPaginaDibujo.add( oForma )
 
 End Sub

La mayoría de las formas, comparten casi todas las mismas propiedades (línea, relleno, texto, sombra, etc), veamos las principales que comparten entre si y después las particulares de algunas.

Principales propiedades de línea.

 Sub AutoFormas5()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Creamos una elipse
     oForma = ThisComponent.createInstance("com.sun.star.drawing.EllipseShape")
     Call CambiaTam( oForma, 10000, 5000 )
     With oForma
         'El estilo de línea
         .LineStyle = com.sun.star.drawing.LineStyle.SOLID
         'El color de la línea
         .LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
         'La transparencia de la línea
         .LineTransparence = 50
         'El ancho de la línea
         .LineWidth = 500
     End With
     oPaginaDibujo.add( oForma )
 
 End Sub

El estilo de línea, esta determinado por la siguiente enumeración.

com.sun.star.drawing.LineStyle	Valor	Valor en Interfaz
com.sun.star.drawing.LineStyle.NONE	0	Oculta
com.sun.star.drawing.LineStyle.SOLID	1	Solida
com.sun.star.drawing.LineStyle.DASH	2	Guiones

El color (LineColor) de la línea es un valor tipo largo (long), la transparencia (LineTransparence) puede tomar valores de 0 (menos transparencia) a 100 (más transparencia), si establece el valor en cero la línea no se verá como si establecieras el estilo en oculta (NONE), el ancho de la línea se establece en centésimas de milímetro y se reparte de forma equidistante del dentro hacia afuera y dentro de la forma, si estableces este valor en cero, no desaparece completamente, queda visible aun, por ello, mejor usa el estilo si lo que quieres es no mostrar la línea. Si estableces el estilo en guiones (DASH), puedes establecer el estilo de este de dos maneras, la primera más sencilla, estableces el nombre de estilo como en.

 Sub AutoFormas6()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Seleccionamos el primero objeto de dibujo
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el estilo en guiones
     oForma.LineStyle = com.sun.star.drawing.LineStyle.DASH
     'Establecemos el estilo 
     oForma.LineDashName = "Fine Dashed"
 
 End Sub

Los nombres que puedes establecer son:

Si las vas a usar seguido, lo más practico es crear una matriz con los nombres.

 Sub AutoFormas7()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mEstilos()
 
     mEstilos = Array("Ultrafine Dashed","Fine Dashed","Ultrafine 2 Dots 3 Dashes","Fine Dotted","Line with Fine Dots","Fine Dashed (var)","3 Dashes 3 Dots (var)","Ultrafine Dotted (var)","Line Style 9","2 Dots 1 Dash")
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Seleccionamos el primero objeto de dibujo
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el estilo en guiones
     oForma.LineStyle = com.sun.star.drawing.LineStyle.DASH
     'Establecemos el estilo 
     oForma.LineDashName = mEstilos(4)
 
 End Sub

Recuerda que los estilos de línea, son completamente personalizables desde la interfaz del usuario, por lo que estos nombres pueden cambiar, el nombre debe corresponder exactamente, incluso sus mayúsculas, minúsculas, números y espacios, con el nombre de la interfaz, de lo contrario, te dará un error en tiempo de ejecución. Si quieres asegúrate de que no haya error, puedes usar la otra forma de establecer el estilo, creando un estilo completamente nuevo y personalizado, el cual, esta estructurado de la siguiente manera.

• Número de puntos (Dots)
• Número de guiones (Dashes)
• Ancho del punto (DotLen)
• Distancia en elementos (Distance)
• Ancho del guión (DashLen)

Para crear un estilo similar al anterior, usamos el siguiente código.

 Sub AutoFormas8()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim oLineaGuion As Object
 
     oLineaGuion = createUnoStruct("com.sun.star.drawing.LineDash")
     'Todas las medidas en centésimas de milímetro
     With oLineaGuion
         .Style = 0
         .Dots = 3
         .DotLen = 500
         .Dashes = 2
         .DashLen = 2000
         .Distance = 250 
     End With
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     oForma.LineStyle = com.sun.star.drawing.LineStyle.DASH
     'Establecemos el estilo 
     oForma.LineDash = oLineaGuion
 
 End Sub

Observa que también aquí tenemos un estilo (Style), de acuerdo a la enumeración.

com.sun.star.drawing.DashStyle	Valor	Valor en Interfaz
com.sun.star.drawing.DashStyle.RECT	0	Rectángulo
com.sun.star.drawing.DashStyle.ROUND	1	Punto
com.sun.star.drawing.DashStyle.RECTRELATIVE	2	Rectángulo, relativo a la longitud de la línea
com.sun.star.drawing.DashStyle.ROUNDRELATIVE	3	Punto, relativo a la longitud de la línea

Para que notes las diferencias de estos estilos, establece la línea en un ancho bastante visible y nota como cambia.

Principales propiedades de relleno

Ahora veamos las principales propiedades de relleno. La primera es, sin relleno.

 Sub AutoFormas9()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en invisible
     oForma.FillStyle = 0
 
 End Sub

El estilo de fondo (FillStyle), esta determinado por la enumeración.

com.sun.star.drawing.FillStyle	Valor	Valor en Interfaz
com.sun.star.drawing.FillStyle.NONE	0	Invisible
com.sun.star.drawing.FillStyle.SOLID	1	Color
com.sun.star.drawing.FillStyle.GRADIENT	2	Gradiente
com.sun.star.drawing.FillStyle.HATCH	3	Trama
com.sun.star.drawing.FillStyle.BITMAP	4	Bitmap (Imagen)

Establecemos un color aleatorio en la primer forma de la hoja.

 Sub AutoFormas10()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en color
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     'Un color aleatorio
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
 End Sub

Puedes establecer el porcentaje (0 a 100) de transparencia, un valor de 100, será similar a establecer el estilo de fondo en invisible (NONE), la diferencia será que si lo estableces con el estilo, el fondo se “quita” y puedes seleccionar las celdas que estén debajo de la forma, si lo haces con la transparencia, al dar clic dentro de la forma, seleccionas la forma.

 Sub AutoFormas11()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en color
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     'Un color aleatorio
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     'La transparencia del color
     oForma.FillTransparence = 50
 
 End Sub

Para establecer el fondo en un gradiente, usamos.

 Sub AutoFormas12()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en gradiente
     oForma.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
     'El nombre del gradiente
     oForma.FillGradientName = "Rectangular red/white"
 
 End Sub

El nombre es el mismo usado por la interfaz del usuario pero en ingles y debe ser exacto, si no, te dará un error en tiempo de ejecución, los gradientes predeterminados si no los ha cambiado el usuario son:

Con una matriz para los nombres, es más sencillo establecerlos.

 Sub AutoFormas13()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mGradiente()
 
     'Matriz con los nombres de los gradientes
     mGradiente = Array("Gradient 1","Gradient 2","Gradient 3","Gradient 4","Gradient 5","Gradient 6",_
	 "Linear blue/white","Radial green/black","Rectangular red/white","Square yellow/white",_
	 "Linear magenta/green","Linear yellow/brown","Radial red/yellow",_
	 "Ellipsoid blue grey/light blue","Axial light red/white")    
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en gradiente
     oForma.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
     'El nombre del gradiente
     oForma.FillGradientName = mGradiente(4)
 
 End Sub

Cambiamos de tipo de fondo y establecemos el estilo en trama (HATCH).

 Sub AutoFormas14()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en trama
     oForma.FillStyle = com.sun.star.drawing.FillStyle.HATCH
     'El nombre de la trama
     oForma.FillHatchName = "Black 45 Degrees Wide"
 
 End Sub

Al igual que con los nombres de los gradientes, estos deben establecerse exactamente como se muestran a continuación y, también, son susceptibles de ser modificados por el usuario desde la interfaz del usuario.

 Sub AutoFormas15()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mTramas()
 
     'Matriz con los nombres de las tramas predeterminadas
     mTramas = Array("Black 0 Degrees","Black 45 Degrees","Black -45 Degrees",_
	 "Black 90 Degrees","Red Crossed 45 Degrees","Red Crossed 0 Degrees",_
	 "Blue Crossed 45 Degrees","Blue Crossed 0 Degrees","Blue Triple 90 Degrees",_
	 "Black 45 Degrees Wide")    
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en trama
     oForma.FillStyle = com.sun.star.drawing.FillStyle.HATCH
     'El nombre de la trama
     oForma.FillHatchName = mTramas(5)
 
 End Sub

Puedes combinar el uso de una trama con un fondo de color, procura establecer un color de fondo claro, para que se distinga la trama.

 Sub AutoFormas16()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en trama
     oForma.FillStyle = com.sun.star.drawing.FillStyle.HATCH
     'El nombre de la trama
     oForma.FillHatchName = "Black 45 Degrees Wide"
     'Tambien con color
     oForma.FillBackground = True
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
 End Sub

Para establecer una imagen como fondo de una forma, tienes que cambiar el estilo y establecer el nombre de la imagen, que como en los demás estilos, debe estar escrito correctamente y puede ser cambiado por el usuario desde la interfaz.

 Sub AutoFormas17()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mImagen()
 
     mImagen = Array("Empty","Sky","Aqua","Coarse","Space",_
	 "Metal","Wet","Marble","Linen","Stone","Space Metal",_
	 "Pebbles","Wall","Red Wall","Pattern","Leaves","Lawn Artificial",_
	 "Daisy","Orange","Fiery","Roses")
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en Imagen
     oForma.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
     'El nombre de la imagen
     oForma.FillBitmapName = mImagen(10)
 
 End Sub

Estos nombres corresponden a.

Puedes establecer una imagen, y al mismo tiempo el nivel de transparencia.

 Sub AutoFormas18()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mImagen()
 
     mImagen = Array("Empty","Sky","Aqua","Coarse","Space",_
	 "Metal","Wet","Marble","Linen","Stone","Space Metal",_
	 "Pebbles","Wall","Red Wall","Pattern","Leaves",_
	 "Lawn Artificial","Daisy","Orange","Fiery","Roses")
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos el relleno en Imagen
     oForma.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
     'El nombre de la imagen
     oForma.FillBitmapName = mImagen(15)
     oForma.FillTransparence = 50
 
 End Sub

Puedes establecer la imagen, desde un archivo de imagen.

 Sub AutoFormas19()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     oForma.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
     'El nombre de la imagen, tomado de un archivo
     oForma.FillBitmapURL = ConvertToURL( "/home/mau/fondo.jpg" )
     'Es modo con que se muestra
     oForma.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
 
 End Sub

El modo de imagen, esta determinado por la enumeración.

com.sun.star.drawing.BitmapMode	Valor	Valor en Interfaz
com.sun.star.drawing.BitmapMode.REPEAT	0	Repetir
com.sun.star.drawing.BitmapMode.STRETCH	1	Ajustar
com.sun.star.drawing.BitmapMode.NO_REPEAT	2	No repetir

La imagen no necesariamente tiene que estar en tu equipo, puede estar al otro lado del mundo, si la ruta no existe no te dará error pero obvio, no te mostrará la imagen.

 Sub AutoFormas20()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     oForma.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
     'El nombre de la imagen, tomado de un archivo de internet
     oForma.FillBitmapURL = ConvertToURL( "http://www.universolibre.org/archivos/favicon.png" )
 End Sub

Principales propiedades de sombra

Ahora veamos las principales propiedades de la sombra de una forma.

 Sub AutoFormas21()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos que queremos mostrar la sombra
     oForma.Shadow = True
     'Establecemos el color de la sombra
     oForma.ShadowColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     'Establecemos el nivel de transparencia de la sombra
     oForma.ShadowTransparence = 50
 
 End Sub

Si no quieres mostrarla solo establece la sombra (Shadow) en falso (False), el color y la transparencia tienen las mismas particularidades ya vistas. Puedes posicionar la imagen, en relación a la forma, donde quieras, por ejemplo, para establecer la sombra a 3 milímetros de la forma, usamos.

 Sub AutoFormas22()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     'Establecemos que queremos mostrar la sombra
     oForma.Shadow = True
     'Establecemos el color de la sombra
     oForma.ShadowColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     'Establecemos la distancia X - Y de la sombra en centésimas de milímetro
     oForma.ShadowXDistance = 300
     oForma.ShadowYDistance = 300
 
 End Sub

Si establecemos la posición (ShadowXDistance y ShadowYDistance) en 0, la sombra queda “detrás” de la forma y es “como” si la ocultaras, para establecer la forma en otra posición de la forma, puedes establecer estas propiedades en valores negativos, por ejemplo, para posicionarla en el extremo inferior izquierdo, estableces los valores en.

 Sub AutoFormas23()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     oForma.Shadow = True
     oForma.ShadowColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     'Establecemos la distancia X - Y de la sombra en centésimas de milímetro
     oForma.ShadowXDistance = -500
     oForma.ShadowYDistance = 300
 
 End Sub

Otras propiedades de las autoformas

Podemos establecer si la forma se va a imprimir o no, si se puede mover o no y si se puede cambiar el tamaño o no, con las siguientes propiedades.

 Sub AutoFormas24()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
 
     'Establecemos que no se imprima la forma
     oForma.Printable = False
     'Que no se pueda mover
     oForma.MoveProtect = True
     'Que no cambie el tamaño
     oForma.SizeProtect = True
 
 End Sub

Podemos establecer el ángulo de rotación de la forma. La unidad de este valor son centésimas de grado y el sentido de rotación es inverso al giro de las manecillas del reloj.

 Sub AutoFormas25()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
 
     'Establecemos el ángulo de rotación en 45º
     'unidades en centésimas de grado
     oForma.RotateAngle = 4500    
 
 End Sub

También podemos modificar la inclinación de la forma, la unidad también son centésimas de grado, pero no todas las formas lo soportan, este valor solo puede estar comprendido entre 0º y 89º.

 Sub AutoFormas26()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
 
     'Establecemos el ángulo de inclinación
     oForma.ShearAngle = 1500
 
 End Sub

También podemos cambiar el orden de las formas, es decir, quien esta delante de quien, esta propiedad, algunas formas especiales como rombos o corazones no la soportan, el siguiente ejemplo intercambia la posición de las dos primeras formas, asegúrate de tener al menos dos formas en tu hoja y de preferencia formas estándar, rectángulos o círculos para que veas el efecto.

 Sub AutoFormas27()
 Dim oPaginaDibujo As Object
 Dim oForma1 As Object
 Dim oForma2 As Object
 Dim Pos1 As Integer
 Dim Pos2 As Integer
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma1 = oPaginaDibujo.getByIndex(0)
     oForma2 = oPaginaDibujo.getByIndex(1)
 
     Pos1 = oForma1.ZOrder
     Pos2 = oForma2.ZOrder
 
     oForma1.ZOrder = Pos2
     oForma2.ZOrder = Pos1
 
 End Sub

Puedes cambiar el nombre de la forma, es importante que lo establezcas para que puedas verlo en el navegador (F5) de contenido del archivo.

 Sub AutoFormas28()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
 
     'Establecemos el nombre de la forma
     oForma.Name = "Circulo Azul"
 
 End Sub

Agrupando y desagrupando formas

Para agrupar formas, usamos el siguiente código.

 Sub AutoFormas29()
 Dim oPaginaDibujo As Object
 Dim oGrupoFormas As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oGrupoFormas = createUnoService("com.sun.star.drawing.ShapeCollection")
     'Necesitamos al menos dos formas para agrupar
     If oPaginaDibujo.getCount >= 2 Then
         'Agregamos las dos primeras
         oGrupoFormas.add( oPaginaDibujo.getByIndex(0)    )
         oGrupoFormas.add( oPaginaDibujo.getByIndex(1)    )
         'Las agrupamos
         oPaginaDibujo.group( oGrupoFormas )
     Else
         MsgBox "Agrega más formas para poder agrupar"
     End If
 
 End Sub

Si el elemento a agregar no existe te dará un error en tiempo de ejecución. En un grupo puedes editar cada elemento que lo contiene de la siguiente manera.

 Sub AutoFormas30()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim co1 As Integer
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Accedemos a la primer forma de la hoja
     oForma = oPaginaDibujo.getByIndex(0)
     'Checamos que sea un grupo
     If oForma.supportsService("com.sun.star.drawing.GroupShape") Then
         'Recorremos todas las formas que contiene
         For co1 = 0 To oForma.getCount - 1
             'Cambiamos el color y el tamaño de cada forma aleatoriamente
             oForma.getByindex(co1).FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
             Call CambiaTam( oForma.getByindex(co1), Rnd()*10000+1000, Rnd()*5000+1000)
         Next
     End If
 
 End Sub

El ejemplo anterior, te dará un error en un caso determinado, tu tarea es averiguar en cual, puedes deducirlo a partir de lo que se comenta en el ejemplo 32 y mejorar este ejemplo para que funcione en todos los casos.

Para desagrupar un grupo, usamos el siguiente código.

 Sub AutoFormas31()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = oPaginaDibujo.getByIndex(0)
     If oForma.supportsService("com.sun.star.drawing.GroupShape") Then
         'Si es un grupo, lo desagrupamos
         oPaginaDibujo.ungroup( oForma )
     End If
 
 End Sub

Toma en cuenta que cuando desagrupas, el número de elementos que contenía el grupo, se suma a la cuenta de formas de la página de dibujo, por eso, este número varía en función de agrupar o desagrupar formas, toma en cuenta esto cuando trates de recorrer todas las formas de la página de dibujo, el siguiente ejemplo, te desagrupa “todos” los grupos existentes.

 Sub AutoFormas32()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim co1 As Long
 Dim bHayGrupo As Boolean
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     If oPaginaDibujo.getCount > 0 Then
         Do
             oForma = oPaginaDibujo.getByIndex(co1)
             If oForma.supportsService("com.sun.star.drawing.GroupShape") Then
                 oPaginaDibujo.ungroup( oForma )
                 'Reiniciamos la cuenta para empezar de cero
                 co1 = 0
             Else
                 co1 = co1 + 1
             End If
         'Cuando co1 = número de formas, significa que recorrió todas 
         'las formas sin encontrar más grupos, por lo que salimos.
         Loop While co1 < oPaginaDibujo.getCount
     End If
 
 End Sub

Trabajando con Fontwork

Para insertar un texto con Fontwork, usamos.

 Sub FontWork1()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mProp(0) As New com.sun.star.beans.PropertyValue
 Dim mOpc(1) As New com.sun.star.beans.PropertyValue
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Agregamos una forma personalizada (CustomShape)
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
 
     'Cambiamos algunas propiedades conocidas    
     Call CambiaTam( oForma, 15000, 4000 )
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
     oPaginaDibujo.add( oForma )
     'Establecemos el texto de la forma
     oForma.String = "OpenOffice.org Basic"
 
     'Esta propiedad es importante, le decimos que use una ruta para el texto
     'que es lo que le da su particularidad a FontWork
     mProp(0).Name = "TextPath"
     mProp(0).Value = True
 
     'Establecemos el tipo de FontWork
     mOpc(0).Name = "Type"
     mOpc(0).Value = "fontwork-wave"
     'Establecemos las propiedades de la ruta del texto
     mOpc(1).Name = "TextPath"
     mOpc(1).value = mProp()
     'Aplicamos estas propiedades personalizadas
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
 End Sub

La mayoría de las propiedades con las formas Fontwork, se establecen como una matriz de propiedades, el tipo (Type) de la forma, determinará el estilo del Fontwork insertado, este valor, que es una cadena (string), debe estar “exactamente” escrito, si no, no te dará ningún error pero la forma no se insertará, tienes cuarenta estilos para escoger, si combinas el tamaño, el color y estilo de línea, el color y estilo de relleno, tienes muchas, muchas posibilidades para personalizar las formas. En el siguiente ejemplo, insertamos una forma, pero seleccionamos aleatoriamente el tipo del Fontwork.

 Sub FontWork2()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mProp(0) As New com.sun.star.beans.PropertyValue
 Dim mOpc(1) As New com.sun.star.beans.PropertyValue
 Dim mTipoFW()
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
 
     mTipoFW = Array("fontwork-plain-text","fontwork-wave","fontwork-inflate","fontwork-stop",_
	 "fontwork-curve-up","fontwork-curve-down","fontwork-triangle-up","fontwork-triangle-down",_
	 "fontwork-fade-right","fontwork-fade-left","fontwork-fade-up","fontwork-fade-down",_
	 "fontwork-slant-up","fontwork-slant-down","fontwork-fade-up-and-right",_
	 "fontwork-fade-up-and-left","fontwork-chevron-up","fontwork-chevron-down",_
	 "fontwork-arch-up-curve","fontwork-arch-down-curve","fontwork-arch-left-curve",_
	 "fontwork-arch-right-curve","fontwork-circle-curve","fontwork-open-circle-curve",_
	 "fontwork-arch-up-pour","fontwork-arch-down-pour","fontwork-arch-left-pour",_
	 "fontwork-arch-right-pour","fontwork-circle-pour","fontwork-open-circle-pour",_
	 "mso-spt142","mso-spt143","mso-spt157","mso-spt158","mso-spt159","mso-spt161",_
	 "mso-spt162","mso-spt163","mso-spt164","mso-spt165","mso-spt166","mso-spt167",_
	 "mso-spt174","mso-spt175")
 
     Call CambiaTam( oForma, 15000, 4000 )
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
     oPaginaDibujo.add( oForma )
     oForma.String = "OpenOffice.org Basic"
 
     mProp(0).Name = "TextPath"
     mProp(0).Value = True
 
     'Establecemos el tipo de FontWork aleatoriamente
     mOpc(0).Name = "Type"
     mOpc(0).Value = mTipoFW( Rnd()*UBound(mTipoFW) )
     mOpc(1).Name = "TextPath"
     mOpc(1).value = mProp()
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
 End Sub

En el siguiente ejemplo, insertamos una forma Fontwork en 3D.

 Sub FontWork3()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mProp(0) As New com.sun.star.beans.PropertyValue
 Dim mPropEx(0) As New com.sun.star.beans.PropertyValue
 Dim mOpc(2) As New com.sun.star.beans.PropertyValue
 Dim mTipoFW()
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
 
     mTipoFW = Array("fontwork-plain-text","fontwork-wave","fontwork-inflate","fontwork-stop",_
	 "fontwork-curve-up","fontwork-curve-down","fontwork-triangle-up","fontwork-triangle-down",_
	 "fontwork-fade-right","fontwork-fade-left","fontwork-fade-up","fontwork-fade-down",_
	 "fontwork-slant-up","fontwork-slant-down","fontwork-fade-up-and-right",_
	 "fontwork-fade-up-and-left","fontwork-chevron-up","fontwork-chevron-down",_
	 "fontwork-arch-up-curve","fontwork-arch-down-curve","fontwork-arch-left-curve",_
	 "fontwork-arch-right-curve","fontwork-circle-curve","fontwork-open-circle-curve",_
	 "fontwork-arch-up-pour","fontwork-arch-down-pour","fontwork-arch-left-pour",_
	 "fontwork-arch-right-pour","fontwork-circle-pour","fontwork-open-circle-pour",_
	 "mso-spt142","mso-spt143","mso-spt157","mso-spt158","mso-spt159","mso-spt161",_
	 "mso-spt162","mso-spt163","mso-spt164","mso-spt165","mso-spt166","mso-spt167",_
	 "mso-spt174","mso-spt175")
 
     Call CambiaTam( oForma, 15000, 4000 )
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
     oPaginaDibujo.add( oForma )
     oForma.String = "OpenOffice.org Basic"
 
     mProp(0).Name = "TextPath"
     mProp(0).Value = True
     mPropEx(0).Name = "Extrusion"
     mPropEx(0).Value = True
 
     'Establecemos el tipo de FontWork aleatoriamente
  mOpc(0).Name = "Type"
  mOpc(0).Value = mTipoFW( CInt(Rnd()*UBound(mTipoFW)) )
     mOpc(1).Name = "TextPath"
  mOpc(1).value = mProp()
     mOpc(2).Name = "Extrusion"
  mOpc(2).value = mPropEx() 
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
 End Sub

Y mira que linda quedo, claro, te confieso que hice varios intentos hasta que salio esta que me gusto.

Tanto las propiedades de la ruta del texto (TextPath), como de la configuración en 3D (Extrusion), tienes varias propiedades más para personalizarse completamente, describirlas todas sale del propósito de este tema, pero esperamos abordarlas a profundidad en Draw.

Propiedades particulares de algunas formas

Los rectángulos y los marcos de texto, son formas muy similares, los dos soportan casi las mismas propiedades, por ejemplo, establecer el radio de las esquinas y personalizar el comportamiento del texto que contiene.

 Sub AutoFormasEspeciales1()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Creamos un marco de texto
     oForma = ThisComponent.createInstance("com.sun.star.drawing.TextShape")
     Call CambiaTam( oForma, 10000, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.setString("Marco con texto" & Chr(13) & "Otra línea")
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     'Establecemos el radio de las esquinas
     oForma.CornerRadius = 1000
     'Establecemos que el texto se adapte al tamaño de la forma
     oForma.TextFitToSize = 1
 End Sub

Reemplaza TextShape por RectangleShape y veras que sigue funcionando.

Las líneas tienes propiedades únicas, como la posibilidad de establecer el inicio y el final de forma diferente. El siguiente ejemplo agrega una línea ¿de?, tu tarea es decirme que distancia tiene la línea.

 Sub AutoFormasEspeciales2()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Creamos una línea
     oForma = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
     Call CambiaTam( oForma, 10000, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 200
 
 End Sub

En el siguiente ejemplo, agregamos una línea vertical y otra horizontal.

 Sub AutoFormasEspeciales3()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     'Creamos una línea horizontal
     oForma = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
     Call CambiaTam( oForma, 5000, 0 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 200
 
     'Ahora una vertical
     oForma = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
     Call CambiaTam( oForma, 0, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 200
 
 End Sub

Observa como hemos logrado dibujar una línea horizontal, tan solo pasándole el valor X para cambiar el tamaño, como valor Y establecemos 0, y, lo contrario para la línea vertical.

En el siguiente ejemplo, establecemos el inicio y el final de la línea, con un cuadro a 45º, lo que te permite acotar otros elementos.

 Sub AutoFormasEspeciales4()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
     Call CambiaTam( oForma, 10000, 0 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 300
     'Establecemos el ancho de inicio y final de línea
     oForma.LineStartWidth = 1000
     oForma.LineEndWidth = 1000
     'Establecemos el tipo de inicio y fin de línea
     oForma.LineStartName = "Square 45"
     oForma.LineEndName = "Square 45"
 
 End Sub

Ahora, establecemos flechas como final de línea.

 Sub AutoFormasEspeciales5()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
     Call CambiaTam( oForma, 10000, 0 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 300
     'Establecemos el ancho de inicio y final de línea
     oForma.LineStartWidth = 1000
     oForma.LineEndWidth = 1000
     'Establecemos el tipo de inicio y fin de línea
     oForma.LineStartName = "Arrow"
     oForma.LineEndName = "Arrow"
 
 End Sub

Para terminar este tema, veamos como insertar otros tipos de formas, solo algunos.

 Sub AutoFormasEspeciales6()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mOpc(0) As New com.sun.star.beans.PropertyValue
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
     Call CambiaTam( oForma, 5000, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 300
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
     'Agregamos un hexágono
     mOpc(0).Name = "Type"
     mOpc(0).Value = "hexagon"
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
     Call CambiaTam( oForma, 5000, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 300
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
     'Agregamos un corazón
     mOpc(0).Name = "Type"
     mOpc(0).Value = "heart"
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
     Call CambiaTam( oForma, 5000, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 300
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
 
     'Agregamos el símbolo de ordenar en un diagrama de flujo
     mOpc(0).Name = "Type"
     mOpc(0).Value = "flowchart-sort"
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
 End Sub

Como ya lo notaste, hay que indicarle el nombre de la forma especial que queremos agregar, la cantidad de formas es grande, compruébalo tu mismo con el siguiente código donde agregamos una forma aleatoria de las diferentes doscientas un posibles.

 Sub AutoFormasEspeciales7()
 Dim oPaginaDibujo As Object
 Dim oForma As Object
 Dim mOpc(0) As New com.sun.star.beans.PropertyValue
 Dim mTipoFormas
 
     mTipoFormas = Array("rectangle", "round-rectangle", "ellipse", "diamond", "isosceles-triangle", "right-triangle", "parallelogram", "trapezoid", "hexagon",_
	 "octagon", "cross", "star5", "right-arrow", "mso-spt14", "pentagon-right", "cube",_
	 "mso-spt17", "mso-spt18", "mso-spt19", "mso-spt20", "mso-spt21", "can", "ring",_
	 "mso-spt24", "mso-spt25", "mso-spt26", "mso-spt27", "mso-spt28", "mso-spt29",_
	  "mso-spt30", "mso-spt31", "mso-spt32", "mso-spt33", "mso-spt34", "mso-spt35",_
	  "mso-spt36", "mso-spt37", "mso-spt38", "mso-spt39", "mso-spt40", "mso-spt41",_
	  "mso-spt42", "mso-spt43", "mso-spt44", "mso-spt45", "mso-spt46", "line-callout-1",_
	  "line-callout-2", "mso-spt49", "mso-spt50", "mso-spt51", "mso-spt52", "mso-spt53",_
	  "mso-spt54", "chevron", "pentagon", "forbidden", "star8", "mso-spt59", "mso-spt60",_
	  "rectangular-callout", "round-rectangular-callout", "round-callout", "mso-spt64",_
	  "paper", "left-arrow", "down-arrow", "up-arrow", "left-right-arrow", "up-down-arrow",_
	  "mso-spt71", "bang", "lightning", "heart", "mso-spt75", "quad-arrow",_
	  "left-arrow-callout", "right-arrow-callout", "up-arrow-callout", "down-arrow-callout",_
	  "left-right-arrow-callout", "up-down-arrow-callout", "quad-arrow-callout",_
	  "quad-bevel", "left-bracket", "right-bracket", "left-brace", "right-brace",_
	  "mso-spt89", "mso-spt90", "mso-spt91", "star24", "striped-right-arrow", "notched-right-arrow",_
	  "block-arc", "smiley", "vertical-scroll", "horizontal-scroll", "circular-arrow",_
	  "mso-spt100", "mso-spt101", "mso-spt102", "mso-spt103", "mso-spt104", "mso-spt105",_
	  "cloud-callout", "mso-spt107", "mso-spt108", "flowchart-process", "flowchart-decision",_
	  "flowchart-data", "flowchart-predefined-process", "flowchart-internal-storage",_
	  "flowchart-document", "flowchart-multidocument", "flowchart-terminator",_
	  "flowchart-preparation", "flowchart-manual-input", "flowchart-manual-operation",_
	  "flowchart-connector", "flowchart-card", "flowchart-punched-tape",_
	  "flowchart-summing-junction", "flowchart-or", "flowchart-collate", "flowchart-sort",_
	  "flowchart-extract", "flowchart-merge", "mso-spt129", "flowchart-stored-data",_
	  "flowchart-sequential-access", "flowchart-magnetic-disk", "flowchart-direct-access-storage",_
	  "flowchart-display", "flowchart-delay", "fontwork-plain-text", "fontwork-stop", "fontwork-triangle-up",_
	  "fontwork-triangle-down", "fontwork-chevron-up", "fontwork-chevron-down", "mso-spt142", "mso-spt143",_
	  "fontwork-arch-up-curve", "fontwork-arch-down-curve", "fontwork-circle-curve", "fontwork-open-circle-curve",_
	  "fontwork-arch-up-pour", "fontwork-arch-down-pour", "fontwork-circle-pour", "fontwork-open-circle-pour",_
	  "fontwork-curve-up", "fontwork-curve-down", "fontwork-fade-up-and-right", "fontwork-fade-up-and-left",_
	  "fontwork-wave", "mso-spt157", "mso-spt158", "mso-spt159", "fontwork-inflate", "mso-spt161",_
	  "mso-spt162", "mso-spt163", "mso-spt164", "mso-spt165", "mso-spt166", "mso-spt167", "fontwork-fade-right",_
	  "fontwork-fade-left", "fontwork-fade-up", "fontwork-fade-down", "fontwork-slant-up", "fontwork-slant-down",_
	  "mso-spt174", "mso-spt175", "flowchart-alternate-process", "flowchart-off-page-connector", "mso-spt178", "mso-spt179",_
	  "mso-spt180", "line-callout-3", "mso-spt182", "sun", "moon", "bracket-pair", "brace-pair", "star4", "mso-spt188",_
	  "mso-spt189", "mso-spt190", "mso-spt191", "mso-spt192", "mso-spt193", "mso-spt194", "mso-spt195", "mso-spt196",_
	  "mso-spt197", "mso-spt198", "mso-spt199", "mso-spt200", "mso-spt201", "mso-spt202" )
 
     oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
     oForma = ThisComponent.createInstance("com.sun.star.drawing.CustomShape")
     Call CambiaTam( oForma, 5000, 5000 )
     oPaginaDibujo.add( oForma )
     oForma.LineColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     oForma.LineWidth = 300
     oForma.FillStyle = com.sun.star.drawing.FillStyle.SOLID
     oForma.FillColor = RGB( Rnd()*255,Rnd()*255,Rnd()*255 )
     'Agregamos una forma aleatoria
     mOpc(0).Name = "Type"
     mOpc(0).Value = mTipoFormas( CInt(Rnd()*UBound(mTipoFormas)) )
     oForma.setPropertyValue("CustomShapeGeometry", mOpc() ) 
 
 End Sub

Si tienes dudas acerca de lo aquí explicado, tienes algún problema con AOO, o quieres ampliar la información, no dudes en dirigirte al Foro Oficial en español de Apache OpenOffice para Macros y API UNO