REM  *****  BASIC  *****


Sub OrderData2()
'DESCRIPCIÓN

	'Esta macro organiza los datos del libro diario
	'extraido del sistema con el suministro de algunos datos
	'necesarios para realizar el procedimiento

'VARIABLES
	Dim iBk As Object
	Dim iShts As Object
	Dim DtSht As Object
	Dim ColsToDelete As Object
	Dim RowsToDelete As Object
	Dim iRows As Integer
	Dim iLastRow As Integer
	Dim InputData As Variant
	Dim AskText As String

		iBk = ThisComponent()
		iShts = iBk.getSheets()
		DtSht = iShts.getByIndex(0)

		'Configuración de fila a eliminar

		'Última fila de registro sin totales
		AskText = "Introduzca el número de la última fila sin incluir los totales"
		InputData = Trim(InputBox(AskText))

		If IsNumeric(InputData) Then
			'Se verifica que sea mayor que cero
			If CInt(InputData) <= 0 Then
				'Se notifica al usuario
					Beep
					MsgBox "El número de la Fila debe ser mayor o igual que 1" _
							& Chr(10) & "No se hará ningún cambio al documento", MB_OK, "Dato inadecuado"
				'Se detiene el procedimiento
					Exit Sub
			'Si el dato introducido es adecuado
			Else
				'Se establece el valor del iLastRow
					iLastRow = CInt(InputData)
			End If
		'Si no es numérico
		Else
			'Se notifica al usuario
				Beep
				MsgBox "El número de la fila no puede ser de tipo 'Texto'" _
						& Chr(10) & "No se realizará ningún cambio al documento" _
						& Chr(10) & "Intente nuevamente", MB_OK, "Dato inadecuado"
			'Se detiene el procedimiento
				Exit Sub
		End If

		'Se eliminan las columnas A:B
		ColsToDelete = DtSht.getCellRangeByName("A1:B1").getColumns()
		ColsToDelete.RemoveByIndex(0,2) '0 el índice de la primera columna (A), 2 la cantidad de columnas a eliminar

		'Se eliminan las filas del encabezado
		RowsToDelete = DtSht.getCellRangeByName("A1:A4").getRows()
		RowsToDelete.removeByIndex(0, 4)

		'Se eliminan las filas de totales finales
		RowsToDelete = DtSht.getCellRangeByName("A" & iLastRow - 4 & ":A" & iLastRow).getRows()
		RowsToDelete.removeByIndex(1,4)

		'Se procede a limpiar las filas vacías
		Dim Cntr As Integer
		Dim Description As String
		Dim AccRange As Object
		Dim AccData()
		Dim Rst()
		Dim RstItem As Integer
		Dim Values()
		Dim ValuesItem As Integer
		Dim iValue As Double
		Dim iTrn As String
		Dim Fnd()
		Dim FndItem As Integer
		Dim FndLst()

		AccRange = DtSht.getCellRangeByName("C2:F" & iLastRow - 4)
		AccData = AccRange.getDataArray()

		Dim iRow As Integer
		iRow = 2

		For Cntr = 0 To UBound(AccData)
			'Descripción de la fila examinada
			Description = AccData(Cntr)(1)
			'Si la descripción está vacía
			If Description = "" Then
				'Se elimina
				DtSht.getCellRangeByName("D" & iRow).getRows().removeByIndex(0,1)
			Else
				'Cuenta principal
				RstItem = UBound(Rst) + 1
				Redim Preserve Rst(RstItem)
				Rst(RstItem) = Array(Left(AccData(Cntr)(0), 3))
				'Columna Valor y Movimiento
				If AccData(Cntr)(2) <> 0 Then
                    iValue = AccData(Cntr)(2)
                    iTrn = "Débito"
                Else
                    iValue = -AccData(Cntr)(3)
                    iTrn = "Crédito"
				End If
				ValuesItem = UBound(Values) + 1
				Redim Preserve Values(ValuesItem)
				Values(ValuesItem) = Array(iValue, iTrn)
				'Fondo
				FndLst = Split(Description, " ")
				FndItem = UBound(Fnd) + 1
				Redim Preserve Fnd(FndItem)
				Fnd(FndItem) = Array(FndLst(1))
				'Se ajusta el iRow
				iRow = iRow + 1
			End If
		Next

'Se ajustan las filas
	iLastRow = LastRow(DtSht.getCellRangeByName("A1"))
	DtSht.getCellRangeByName("A2:A" & iLastRow).getRows().Height = 1350

'Se inserta la columna para la cuenta principal y el control del fondo
	With DtSht.getCellRangeByName("C1").getColumns()
		.insertByIndex(0, 1)
		.Width = 2000
	End With
	DtSht.getCellRangeByName("C1").setString("Principal")
	
	'Se cambia el título de la columna Débito por Valor
	DtSht.getCellRangeByName("F1").setString("Valor")
	
	'Se cambia el título de la columna Crédito
	DtSht.getCellRangeByName("G1").setString("Movimiento")

	With DtSht.getCellRangeByName("H1")
		.setString("Fondo")
		.CharWeight = 150
		.getColumns().Width = 2700
	End With

'Imprimiendo la cuenta principal, Valores y el fondo
	'Principal
	Dim PrintArea As Object
	PrintArea = DtSht.getCellRangeByName("C2:C" & iLastRow)
	PrintArea.setDataArray(Rst)
	'Valores
	PrintArea = DtSht.getCellRangeByName("F2:G" & iLastRow)
	PrintArea.setDataArray(Values)
	'Fondo
	PrintArea = DtSht.getCellRangeByName("H2:H" & iLastRow)
	PrintArea.setDataArray(Fnd)

'Trabajo finalizado
	Beep
	MsgBox "Documento Normalizado", MB_OK, "Finalizado"
End Sub