Hola Leonardo...
Hola a todos...
Dicen en mi pueblo que -lo prometido es deuda-, así que te muestro la macro
funcionando en OOo Basic, el código esta insertado entre las instrucciones
originales en VBA comentadas con la palabra clave Rem, traté de mostrarte los
equivalente pero muchas cosas en OOo Basic se implementan de forma diferente.
En mis pruebas funciono igual que tu original pero como ando muy fallo en cosas
contables ya nos contaras como te fue...
Saludos a todos...
Mauricio
Option Explicit
Sub CargarAsiento()
Rem Dim nro_asiento
Dim iNumeroAsiento As Integer
Dim oEsteArchivo As Object
Dim oHojaActiva As Object
Dim oHojaBaseAsientos As Object
Dim sTmp As String
Dim oOrigen As Object
Dim oDestino As Object
Dim lUltimaFila As Long
Const TIPOCONTENIDO As Integer = 7
'1 = com.sun.star.sheet.CellFlags.VALUE
'2 = com.sun.star.sheet.CellFlags.DATETIME
'4 = com.sun.star.sheet.CellFlags.STRING
oEsteArchivo = ThisComponent
Rem 'Activa el bloqueo de actualización de la pantalla (para no mostrar todo lo
que va haciendo la macro y evitar parpadeos del monitor)
Rem Application.ScreenUpdating = False
oEsteArchivo.LockControllers
'Obtenemos una referencia a la hoja actual, o sea, la activa
oHojaActiva = oEsteArchivo.getCurrentController.getActiveSheet()
'Obtenemos el valor de la celda H65
sTmp = oHojaActiva.getCellRangeByName( "H65" ).getString()
Rem 'Consistencia de la Carga
Rem If Range("H65") = "Asiento Correcto" Then
If sTmp = "Asiento Correcto" Then
Rem 'Copiando Carga de Datos de Asiento
Rem Range("A11:I61").Select
Rem Selection.Copy
Rem 'Ubicarse al inicio de la base de asientos en la hoja "Base Asientos"
Rem Sheets("Base Asientos").Activate
Rem ActiveSheet.Range("E2").Select
Rem Selection.End(xlDown).Select 'Baja hasta la última celda llena
Rem Selection.Offset(1, -3).Select 'Baja una celda más, es decir a
Rem 'la primera vacía y tres columnas a la
Rem 'izquierda
Rem 'Pegar Datos de Asiento
Rem Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
'Rango de celdas a copiar
oOrigen = oHojaActiva.getCellRangeByName( "A11:I61" )
'Obtenemos una referencia a la hoja Base Asientos
oHojaBaseAsientos = oEsteArchivo.getSheets.getByName( "Base Asientos" )
'De la columna E, filtramos por las celdas VACIAS
oDestino = oHojaBaseAsientos.getCellRangeByName( "E2:E65536"
).queryEmptyCells()
'La primer fila vacia será la primer fila libre
lUltimaFila = oDestino(0).getRangeAddress.StartRow()
'Redefinimos el destino para empezar en la primer fila libre
oDestino = oHojaBaseAsientos.getCellRangeByPosition(
1,lUltimaFila,9,lUltimaFila+50 )
'Copiamos TODOS los datos del origen al destino, OJO, los rangos deben
ser exactamente del mismo tamaño
oDestino.setDataArray( oOrigen.getDataArray() )
Rem 'Inicio
Rem Sheets("Carga Asientos").Activate
Rem Application.CutCopyMode = False
Rem Range("D5").Select
Rem 'Mensaje Indicando Nro de Asiento
Rem Sheets("Carga Asientos").Activate
Rem nro_asiento = Range("C5").Value
iNumeroAsiento = oHojaActiva.getCellRangeByName( "C5" ).getValue()
Rem MsgBox ("Se ha contabilizado el asiento número " & nro_asiento)
MsgBox "Se ha contabilizado el asiento número " & Str(iNumeroAsiento),
64
Rem 'Numerar próximo Asiento
Rem 'Range("C5").Value = Nro_Asiento + 1
Rem Sheets("Carga Asientos").Activate
Rem Range("M4").Select
Rem Selection.Copy
Rem Range("C5").Select
Rem Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
oHojaActiva.getCellRangeByName( "C5" ).setValue( iNumeroAsiento + 1 )
Rem 'Limpiar Carga de Asiento
Rem Range("D11:E61,G11:H61,D5,E7").Select
Rem Selection.ClearContents
Rem Range("D5").Select
oHojaActiva.getCellRangeByName( "D11:E61" ).clearContents(
TIPOCONTENIDO )
oHojaActiva.getCellRangeByName( "G11:H61" ).clearContents(
TIPOCONTENIDO )
oHojaActiva.getCellRangeByName( "D5" ).clearContents( TIPOCONTENIDO )
oHojaActiva.getCellRangeByName( "E7" ).clearContents( TIPOCONTENIDO )
Rem Else
Else
Rem MsgBox ("Existen errores en la carga del Asiento, por favor, verifique
su consistencia")
MsgBox "Existen errores en la carga del Asiento, por favor, verifique
su consistencia", 16, "Error"
Rem End If
End If
Rem 'Desactiva el bloqueo de actualización de pantalla
Rem Application.ScreenUpdating = True
oEsteArchivo.UnLockControllers
End Sub
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
