Recientemente nos hemos encontrado con varias preguntas realizadas en el foro sobre cómo gestionar los comentarios en Calc mediante macros, y después de hacer un arduo trabajo de investigación, presentamos este sistema de macros que nos permiten agregar, eliminar, mostrar u ocultar los comentarios, así como modificar sus dimensiones y posición, el color de fondo, las propiedades de línea y de la terminación, así como su transparencia, sin olvidarnos del tipo, tamaño y color de fuente.

Las macros han sido desarrolladas pensadas en modificar el comentario de una celda en una hoja, nombrando la hoja por su nombre, lo mismo que la celda, pero fácilmente pueden ser modificadas para que trabajen sobre una variable objeto que contenga un comentario o una colección de comentarios.

No descartamos ir ampliando poco a poco con nuevas macros que, por poner un ejemplo, gestionen imágenes en los comentarios, o cualquier cosa que nos vaya surgiendo.

Esperamos vuestros comentarios y sugerencias.

Estas son las macros desarrolladas:

Agregar un nuevo comentario

Sub Calc_ComentarioAgrega(cHoja As String, cCelda As String, cContenido As String)
' --------------------------------------------------------------------------------------
  Dim oHoja As Object, oComentarios As Object, oCelda As Object
  oHoja = ThisComponent.Sheets.getByName(cHoja)
  oComentarios = oHoja.getAnnotations
  oCelda = oHoja.getCellRangeByName(cCelda)
  oComentarios.insertNew( oCelda.CellAddress, cContenido )
  oCelda.Annotation.isVisible = True
End Sub

Nota: Si ya existe un comentario en la celda, será sustituido por el nuevo

Ejemplo de uso

Sub Main()
  Calc_ComentarioAgrega("Hoja1","C7","Esto es un comentario." & Chr(13) & "Ha sido agregado con una macro en Calc")
End Sub

 

Función comentario

Devuelve el comentario contenido en una celda. Esta función es utilizada por muchas de las macros de esta colección.

Function Calc_Comentario(cHoja As String, cCelda As String) as object
' --------------------------------------------------------------------------------------
 Dim oHoja As Object, oCelda As Object
 oHoja = ThisComponent.Sheets.getByName(cHoja)
 oCelda = oHoja.getCellRangeByName(cCelda)
 Calc_Comentario = oCelda.Annotation
End Function

 

Función comentarios

Devuelve la colección de comentarios contenidos en una hoja. Esta función puede ser utilizada para recorrer uno a uno los comentarios de una hoja.

Function Calc_Comentarios(cHoja As String)
' --------------------------------------------------------------------------------------
 Calc_Comentarios = ThisComponent.Sheets.getByName(cHoja).getAnnotations
End Function

 

Mostrar un comentario

Muestra un comentario oculto

Sub Calc_ComentarioMuestra(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.isVisible = True
End Sub

 

Ocultar un comentario

Oculta un comentario mostrado

Sub Calc_ComentarioOculta(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.isVisible = False
End Sub

 

Mostrar todos los comentarios

Muestra todos los comentarios de la hoja

Sub Calc_ComentariosMuestra(cHoja As String)
' --------------------------------------------------------------------------------------
 Dim oComentarios As Object, oComentario As Object
 oComentarios=Calc_Comentarios(cHoja)
 For Each oComentario In oComentarios
 oComentario.isVisible=true
 Next
End Sub

 

Ocultar todos los comentarios

Oculta todos los comentarios de la hoja

Sub Calc_ComentariosOculta(cHoja As String)
' --------------------------------------------------------------------------------------
 Dim oComentarios As Object, oComentario As Object
 oComentarios=Calc_Comentarios(cHoja)
 For Each oComentario In oComentarios
 oComentario.isVisible=False
 Next
End Sub

 

Eliminar un comentario

Borra el comentario de la hoja celda indicada

Sub Calc_ComentarioElimina(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oHoja As Object,oCelda As Object
 oHoja = ThisComponent.Sheets.getByName(cHoja)
 oCelda = oHoja.getCellRangeByName(cCelda)
 oCelda.clearContents( com.sun.star.sheet.CellFlags.ANNOTATION )
End Sub

 

Agrega un nuevo texto al comentario

Permite insertar un nuevo texto al final de un comentario ya existente.

Sub Calc_ComentarioAmplia(cHoja As String, cCelda As String, cTexto As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object,oText
 oComentario = Calc_Comentario(cHoja,cCelda)
 oText = oComentario.getAnnotationShape.text.getText()
 oText.insertString(oText.createTextCursor,cTexto, False)
End Sub

 

Inserta un hiperenlace en un comentario

Inserta un hiperenlace en un comentario ya existente. El hiperenlace se inserta al final del texto contenido.

Nota: Si no existe un comentario en la celda, dará error.

Sub Calc_ComentarioHyperLink(cHoja As String, cCelda As String, cURL As String, cTexto As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object, oLink, oText
 oComentario = Calc_Comentario(cHoja,cCelda)
 oLink = ThisComponent.createInstance("com.sun.star.text.TextField.URL")
 oLink.URL = ConvertToURL(cURL)
 oLink.Representation = cTexto
 oText = oComentario.getAnnotationShape.text.getText()
 oText.insertTextContent(oText.createTextCursor,oLink,False)
End Sub

 

Para crear un comentario que contenga texto, un hiperenlace y otro texto, podemos utilizar en combinación las macros Calc_ComentarioAgrega, Calc_ComentarioHyperLink y Calc_ComentarioAmplia en ese orden.

Ejemplo de uso:

Sub Main
 Dim CrLf As String
 CrLf = Chr(10) & Chr(12)
 Calc_ComentarioAgrega("Hoja1", "C9", "Este comentario contiene un hiperenlace" & CrLf)
 Calc_ComentarioHyperlink("Hoja1", "C9", "http://open-office.es", "Visita open-office.es")
 Calc_ComentarioAmplia("Hoja1", "C9", CrLf & "y no olvides recomendarnos")
End Sub

 

Autor del comentario

Esta función devuelve una cadena con el nombre del autor del comentario

 

Function Calc_ComentarioAutor(cHoja As String, cCelda As String) As String
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 Calc_ComentarioAutor = oComentario.Author
End Function

 

Agrega nombre del autor al comentario

Agrega el nombre del autor del comentario, seguido de dos puntos y un espacio, al principio del texto del comentario.

Aunque se aplique varias veces, no se muestra más que una vez.

 

Sub Calc_ComentarioAutorAgrega(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.String = oComentario.Author & ": " & Replace(oComentario.String, oComentario.Author & ": ", "")
End Sub

 

Elimina nombre del autor del comentario

Si se agregó el nombre del autor seguido de dos puntos y un espacio al principio del comentario, esta macro lo elimina del comentario.

 

Sub Calc_ComentarioAutorQuita(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.String = Replace(oComentario.String, oComentario.Author & ": ", "")
End Sub

 

Fecha del comentario

Esta función devuelve una variable de fecha con la fecha en que se creó el comentario

 

Function Calc_ComentarioFecha(cHoja As String, cCelda As String) As Date
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 Calc_ComentarioFecha = oComentario.Date
End Function

 

Agrega fecha del comentario

Agrega la fecha del comentario, seguido de dos puntos y un espacio, al principio del texto del comentario.

Aunque se aplique varias veces, no se muestra más que una vez.

 

Sub Calc_ComentarioFechaAgrega(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.String = oComentario.Date & ": " & Replace(oComentario.String, oComentario.Date & ": ", "")
End Sub

 

Elimina fecha del comentario

Si se agregó la fecha seguida de dos puntos y un espacio al principio del comentario, esta macro lo elimina del comentario.

 

Sub Calc_ComentarioFechaQuita(cHoja As String, cCelda As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.String = Replace(oComentario.String, oComentario.Date & ": ", "")
End Sub

 

Propiedades de fuente del comentario

Permite definir algunas de las propiedades de fuente (tipo de letra) del comentario. Las propiedades se aplican a todo el comentario.

Los argumentos que precisa son:

• cFuente: String, define el nombre de la fuente; por ejemplo, "Tahoma" o "Comic Sans MS"
• nPuntos: Integer, define el tamaño en puntos de la fuente; por ejemplo, 14
• cColor:String, define el color de la fuente. Ver función Calc_ComentarioRGBColor.

 

Sub Calc_ComentarioFuente(cHoja As String, cCelda As String, cFuente As String, _
 nPuntos As Integer, cColor As String)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object, nRGB As Long
 oComentario = Calc_Comentario(cHoja,cCelda)
 nRGB = Calc_ComentarioRGBColor(cColor)
 With oComentario.getAnnotationShape()
 .charFontName = cFuente
 .charHeight = nPuntos
 .CharColor = nRGB
 ' también con .setPropertyValue( "CharHeight" , nPuntos ), etc
 End With
End Sub

Ejemplos de uso:

Sub Main
 Calc_ComentarioFuente("Hoja1","C7","Tahoma",14,"Verde")  
 MsgBox "Pulsa una tecla"
 Calc_ComentarioFuente("Hoja1","C7","Open Sans Bold",16,"120,140,255")
End Sub

 

Posición y tamaño del comentario

Permite definir la posición respecto al punto base de la hoja (esquina superior izquierda por defecto), y el tamaño, del comentario.

Los argumentos que precisa son:

• X, Y: Long, expresan la posición X e Y en milésimas de cm (1cm se expresa como 1000)
• nAncho, nAlto: Long, expresan el ancho y el alto del comentario, en milésimas de cm.

 

Sub Calc_ComentarioXYAnchoAlto(cHoja As String, cCelda As String, _
  X As Long, Y As Long, nAncho As Long, nAlto As Long)
' --------------------------------------------------------------------------------------
 Dim oComentario As Object
 Dim sFrameRectNew As New com.sun.star.awt.Rectangle
 sFrameRectNew.X = X
 sFrameRectNew.Y = Y
 sFrameRectNew.width = nAncho
 sFrameRectNew.height = nAlto
 oComentario = Calc_Comentario(cHoja,cCelda)
 oComentario.getAnnotationShape().FrameRect = sFrameRectNew
End Sub

Ejemplo de uso

 

Sub Main
 Calc_ComentarioXYAnchoAlto("Hoja1","C7",10000,3500,6000,3000)  
End Sub

 

Propiedades del fondo del comentario

Permite definir el color y transparencia del fondo (background) del comentario, así como la distancia del texto a los bordes del mismo.

Los argumentos que precisa son:

• cColor: String, define el color del fondo. Ver función Calc_ComentarioRGBColor.
• nTransparencia: Integer, número del 0 al 100 que indica el porcentaje de transparecia del fondo.
• TxtSup, TxtDer, TxtInf, TxtIzq: Long, define la distancia del texto a los bordes superior, derecho, inferior e izquierdo, respectivamente, expresado en milésimas de cm (1cm se expresa como 1000)

 

Sub Calc_ComentarioFondo(cHoja As String, cCelda As String, _
 cColor As String, nTransparencia As Integer, _
 TxtSup As Long, TxtDer As Long, TxtInf As Long, TxtIzq As Long )
' --------------------------------------------------------------------------------------
 Dim oComentario As Object, nRGB As Long
 oComentario = Calc_Comentario(cHoja,cCelda)
 nRGB = Calc_ComentarioRGBColor(cColor)
 With oComentario.getAnnotationShape()
 .FillBackground = True
 .FillColor = nRGB
 .FillStyle = 1
 .FillTransparence = nTransparencia
 .TextLeftDistance = TxtIzq
 .TextLowerDistance = TxtInf
 .TextRightDistance = TxtDer
 .TextUpperDistance = TxtSup
 End With
End Sub

Ejemplo de uso

Sub Main
 Calc_ComentarioFondo("Hoja1","C7","255,185,145",30,500,400,500,400)  
End Sub

 

Propiedades del borde y conector del comentario

Permite definir el color y transparencia del borde y conector (línea) del comentario, así como la terminación (punta de flecha) del mismo.

Los argumentos que precisa son:

• cColor: String, define el color de la línea del borde y del conector. Ver función Calc_ComentarioRGBColor.
• nTransparencia: Integer, número del 0 al 100 que indica el porcentaje de transparecia del borde y del conector del comentario.
• nAncho: Long, define el grosor del borde y del conector, expresado en milésimas de cm (1cm se expresa como 1000).
• nEstiloLinea: Integer, número entre 1 y 12 que define el estilo de línea; cualquier otro valor se considera sin línea. Ver función Calc_ComentarioEstiloLinea.
• nPuntaFlecha: Integer, número entre 1 y 12 que define el estilo de la terminación; cualquier otro valor se considera sin terminación. Ver función Calc_ComentarioPuntaFlecha.
• nAnchoPunta: Long, define el tamaño de la terminación, expresado en milésimas de cm (1cm se expresa como 1000).

 

Sub Calc_ComentarioLinea(cHoja As String, cCelda As String, _
 cColor As String, nTransparencia As Long, nAncho As Long, _
 nEstiloLinea as integer, nPuntaFlecha As Integer, nAnchoPunta As Long )
' --------------------------------------------------------------------------------------
 Dim oComentario As Object, nRGB As Long, cPuntaFlecha As String
 dim cEstiloLinea as string
 oComentario = Calc_Comentario(cHoja,cCelda)
 nRGB = Calc_ComentarioRGBColor(cColor)
 cPuntaFlecha = Calc_ComentarioPuntaFlecha(nPuntaFlecha)
 aEstiloLinea = split(Calc_ComentarioEstiloLinea(nEstiloLinea),";")
 With oComentario.getAnnotationShape()
 .LineColor = nRGB
 .LineWidth = nAncho
 .LineTransparence = nTransparencia
 .LineStartName = cPuntaFlecha
 .LineStartWidth = nAnchoPunta
 if aEstiloLinea(0)="2" then 
 .LineStyle = com.sun.star.drawing.LineStyle.DASH
 .LineDashName = aEstiloLinea(1)
 else
 .LineStyle = aEstiloLinea(0)    
 end if  
 End With
End Sub

Ejemplo de uso

Sub Main
 Calc_ComentarioLinea("Hoja1","C7","azul",30,180,9,10,600)  
End Sub

 

Estilos de terminaciones (punta de flecha)

Esta función auxiliar nos permite seleccionar mediante un valor numérico del 1 al 12 entre los distintos estilos de terminaciones (punta de flecha) disponibles para el conector de los comentarios. En caso de indicar un valor fuera del rango, no se aplicará ninguna terminación.

Los estilos disponibles representados por un valor del 1 al 12 se llaman Flecha, Círculo, Cuadrado, Flecha estrecha, Fines de dimensiones, Flecha doble, Flecha corta redondeada, Flecha simétrica, Flecha línea, Flecha larga redondeada, Cuadrado 45 y Flecha cóncava respectivamente.

 

Function Calc_ComentarioPuntaFlecha(nPuntaFlecha As Integer) As String
' --------------------------------------------------------------------------------------
 Dim cPdF As String
 Select Case nPuntaFlecha
 Case 1:    cPdF = "Flecha"                  ' "Arrow"
 Case 2:    cPdF = "Círculo"                 ' "Circle"
 Case 3:    cPdF = "Cuadrado"                ' "Square"
 Case 4:    cPdF = "Flecha estrecha"         ' "Small Arrow"
 Case 5:    cPdF = "Fines de dimensiones"    ' "Dimension Lines"
 Case 6:    cPdF = "Flecha doble"            ' "Double Arrow"
 Case 7:    cPdF = "Flecha corta redondeada" ' "Rounded short Arrow"
 Case 8:    cPdF = "Flecha simétrica"        ' "Symmetric Arrow"
 Case 9:    cPdF = "Flecha línea"            ' "Line Arrow"
 Case 10:   cPdF = "Flecha larga redondeada" ' "Rounded large Arrow"
 Case 11:   cPdF = "Cuadrado 45"             ' "Square 45"
 Case 12:   cPdF = "Flecha cóncava"          ' "Arrow concave"
 Case else: cPdF = ""                        ' nothing
 End Select
 Calc_ComentarioPuntaFlecha = cPdF
End Function

 

Estilos de línea (borde y conector)

Esta función auxiliar nos permite seleccionar mediante un valor numérico del 1 al 12 entre los distintos estilos de línea disponibles para el borde y el conector de los comentarios. En caso de indicar un valor fuera del rango, se aplicará el estilo - sin -.

Los estilos disponibles representados por un valor del 1 al 12 se llaman Contínuo, Trazos ultrafinos, Trazos finos, Ultrafino 2 puntos 3 trazos, Punteado fino, Línea con puntos finos, Trazo ultrafino (variable), 3 trazos 3 puntos (variables), Punteado ultrafino (variable), Estilo de línea 9, 2 puntos 1 trazo y Trazos (variables) respectivamente.

 

Function Calc_ComentarioEstiloLinea(nEstiloLinea As Integer ) As String
' --------------------------------------------------------------------------------------
 Dim cEdL As String
 Select Case nEstiloLinea
 Case 1:    cEdL = "1;Contínuo"                      ' ""  
 Case 2:    cEdL = "2;Trazos ultrafinos"             ' "Ultrafine Dashed"
 Case 3:    cEdL = "2;Trazos finos"                  ' "Fine Dashed"
 Case 4:    cEdL = "2;Ultrafino 2 puntos 3 trazos"   ' "Ultrafine 2 Dots 3 Dashes"  
 Case 5:    cEdL = "2;Punteado fino"                 ' "Fine Dotted"
 Case 6:    cEdL = "2;Línea con puntos finos"        ' "Line with Fine Dots"
 Case 7:    cEdL = "2;Trazo ultrafino (variable)"    ' "Fine Dashed (var)"
 Case 8:    cEdL = "2;3 trazos 3 puntos (variables)" ' "3 Dashes 3 Dots (var)"
 Case 9:    cEdL = "2;Punteado ultrafino (variable)" ' "Ultrafine Dotted (var)"
 Case 10:   cEdL = "2;Estilo de línea 9"             ' "Line Style 9"
 Case 11:   cEdL = "2;2 puntos 1 trazo"              ' "2 Dots 1 Dash"
 Case 12:   cEdL = "2;Trazos (variables)"            ' "Dashed (var)"
 Case else: cEdL = "0;sin"                           ' nothing
 End Select
 Calc_ComentarioEstiloLinea = cEdL
End Function

 

 

La función devuelve una cadena de texto codificada que será utilizada por Calc_ComentarioLinea para componer el estilo del borde y conector del comentario.

 

Colores (fuente, fondo, borde y conector)

Esta función auxiliar nos permite obtener mediante una cadena (string) el código de color codificado en RGB que se precisa para definir las propiedades color de fuente, color de fondo, color de borde y color de conector de los comentarios en Calc.

El argumento cColor puede ser uno de estos valores:

• Los componentes numéricos rojo, verde y azul (RGB) separados por comas; por ejemplo, "0,0,0" para negro, "255,255,255" para blanco.
• Uno de los siguientes nombres (en castellano); Rojo, Verde, Azul, Amarillo, Magenta, Cian, Gris, Blanco, Negro
• Uno de los siguientes nombres (en inglés); Red, Green, Blue, Yellow, Magenta, Cyan, Grey, White, Black
• Uno de los siguientes nombres: posit01, posit02, posit03, posit04, posit05, posit06, posit07, posit08, posit09, posit10, posit11, posit12

 

Function Calc_ComentarioRGBColor( cColor As String )
' --------------------------------------------------------------------------------------
 Dim aRGB() As Long
 aRGB=array(0,0,0)
 Select Case LCase(cColor)
 Case "rojo","red":         aRGB=array(255,0,0)
 Case "verde","green":      aRGB=array(0,255,0)
 Case "azul","blue":        aRGB=array(0,0,255)
 Case "amarillo", "yellow": aRGB=array(255,255,0)
 Case "magenta":            aRGB=array(255,0,255)
 Case "cian", "cyan":       aRGB=array(0,255,255)
 Case "gris","grey":        aRGB=array(100,100,100)
 Case "blanco", "white":    aRGB=array(255,255,255)
 Case "negro", "black":     aRGB=array(255,255,255)
 Case "posit01":            aRGB=array(247,255,130)  
 Case "posit02":            aRGB=array(207,207,207)
 Case "posit03":            aRGB=array(254,255,148)
 Case "posit04":            aRGB=array(255,46,182)
 Case "posit05":            aRGB=array(174,234,56)      
 Case "posit06":            aRGB=array(255,234,0)
 Case "posit07":            aRGB=array(255,138,18)
 Case "posit08":            aRGB=array(183,255,255)            
 Case "posit09":            aRGB=array(253,157,155)  
 Case "posit10":            aRGB=array(142,89,166)  
 Case "posit11":            aRGB=array(209,210,240)  
 Case "posit12":            aRGB=array(146,201,37)  
 Case Else:                 aRGB=Split(cColor,",")
 End Select
 Calc_ComentarioRGBColor = RGB(aRGB(0),aRGB(1),aRGB(2))
End Function