Apache OpenOffice: Foro oficial de la comunidad

Código: Seleccionar todo

REM  *****  BASIC  *****
Option Explicit

Const ICONO_STOP As Integer = 16
Const BOTON_ACEPTAR As Integer = 0

Sub EstablecerFormato

	' Archivo CALC
	Dim ArchivoCALC As Object
	' Hoja dentro del archivo. En este ejemplo es la hoja activa
	Dim HojaActiva As Object
	' Los distintos formatos que necesito
	Dim CadenasFormatos(5) As String

	On Error GoTo TRATAR_ERROR
	
	ArchivoCALC = ThisComponent
	HojaActiva = ArchivoCALC.CurrentController.getActiveSheet()
	' ¡ATENCIÓN! Estos formatos son para números positivos, el cero y los números negativos aparecerían con el signo - delante
	CadenasFormatos(0) = "\\0000"
	CadenasFormatos(1) = "\\00000000"
	CadenasFormatos(2) = "\\00000000,00"
	' Si quieres formatear los números negativos para que se VEAN igual que los positivos, entonces
	CadenasFormatos(3) = "\\0000;\\0000"
	CadenasFormatos(4) = "\\00000000;\\00000000"
	CadenasFormatos(5) = "\\00000000,00;\\00000000,00"
	' Debes tener en cuenta que el número sigue siendo negativo a efectos de operaciones matemáticas, observa el valor en la barra de fórmulas
	With HojaActiva
		With .getCellRangeByName("A1:A10")
			.NumberFormat = IdxFmtPersonalizado(ArchivoCALC, CadenasFormatos(0))
		End With
		With .getCellRangeByName("B1:B10")
			.NumberFormat = IdxFmtPersonalizado(ArchivoCALC, CadenasFormatos(1))
		End With
		With .getCellRangeByName("C1:C10")
			.NumberFormat = IdxFmtPersonalizado(ArchivoCALC, CadenasFormatos(2))
		End With
		With .getCellRangeByName("D1:D10")
			.NumberFormat = IdxFmtPersonalizado(ArchivoCALC, CadenasFormatos(3))
		End With
		With .getCellRangeByName("E1:E10")
			.NumberFormat = IdxFmtPersonalizado(ArchivoCALC, CadenasFormatos(4))
		End With
		With .getCellRangeByName("F1:F10")
			.NumberFormat = IdxFmtPersonalizado(ArchivoCALC, CadenasFormatos(5))
		End With
	End With
	Exit Sub
TRATAR_ERROR:
	MsgBox "Lo siento pero no puedo mostrar ese formato.", ICONO_STOP + BOTON_ACEPTAR, "¡Atención!"
End Sub

Function IdxFmtPersonalizado(DocCalc As Object, CadFmtPersonal As String) As Long
	'Conjunto de formatos en el entorno local para el archivo CALC
	Dim FmtArchivoCalc As Object
	'Índice que identifica a un formato personalizado en el entorno local
	Dim IdxFmt As Long
	'¿En qué idioma y en qué país?
	Dim EntornoLocal As New com.sun.star.lang.Locale

	'Idioma: Español
	EntornoLocal.Language = "ES"
	'País: España
	EntornoLocal.Country = "ES"

	FmtArchivoCalc = DocCalc.NumberFormats
	IdxFmt = FmtArchivoCalc.queryKey(CadFmtPersonal, EntornoLocal, True)
	If IdxFmt = -1 Then
		IdxFmt = FmtArchivoCalc.addNew(CadFmtPersonal, EntornoLocal)
	End If	
	IdxFmtPersonalizado = IdxFmt
End Function