Tengo un archivo en el cual tengo dos hojas: La primera es la Hoja Activa nombrada "INTERFAZ" en donde tengo un pequeño formulario en donde el usuario introduce unos datos (datos de registro), dos casillas de verificación para marcarlas de acuerdo a la apreciación que haya tenido sobre el registro y una celda combinada en donde introduce sus comentarios sobre el registro hecho. La segunda hoja nombrada "BASE" es el lugar en donde se van archivando los registros que han colocado los usuarios en la "INTERFAZ".
Para que funcione tengo una MACRO que copia los datos y los traslada a la segunda hoja, posteriormente borra los datos de la primera hoja (Limpia esas celdas), para que el usuario pueda ingresar otro registro, además claro de limpiar la seleción de las casillas de verificación. La MACRO se ejecuta mediante un Boton. El problema es que cuando el usuario ingresa un segundo registro, sobreescribe los datos existentes, la idea claro es que vaya ingresado un registro debajo del otro (que los copie en la siguiente fila libre).
Hago referencia a que ya habían resuelto una pregunta similar porque he visto una macro para pasar una linea a otra hoja, La pusé en práctica pero lo que hace es copiar la celda y la traslada a la otra Hoja conservando el formato de la primera, y en el caso de la celda combinada (donde el usuario coloca sus observaciones), tambien la traslada combinada, dañando la base construida en la segunda hoja.
Se que existe el método de solo copiar el valor contenido en la celda (sin sus formatos: alto, ancho, tipo de letra), con la instrucción getDataArray y setDataArray, pero no logro que funcione con la macro para pasar línea.
El código que estoy usando es el siguiente:
Código: Seleccionar todo
Option Explicit
Sub CopiarRango_1()
'Macro final (para ejecutar)
Dim oHojaActiva As Object
Dim oOrigen As Object
Dim oDestino As Object
oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
'Rango a copiar
oOrigen = oHojaActiva.getCellRangeByName("B3:E3")
'Celda destino
oDestino = ThisComponent.Sheets.getByName("BASE").getCellRangeByName("B4:E4")
'Copiamos el rango
oDestino.setDataArray( oOrigen.getDataArray )
Call Borrando1
Call CopiarRango_2
Call CopiarRango_3
Call CasillasVerificacion
End Sub
Sub Borrando1()
'Macro para Borrar
Dim oHojaActiva As Object
Dim oRango As Object
oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
oRango = oHojaActiva.getCellRangeByName("B3:E3")
'Borramos solo los valores
oRango.clearContents( 7 )
End Sub
Sub Borrando2()
'Macro para Borrar
Dim oHojaActiva As Object
Dim oRango As Object
oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
oRango = oHojaActiva.getCellRangeByName("G1:H1")
'Borramos solo los valores
oRango.clearContents( 7 )
End Sub
Sub Borrando3()
'Macro para Borrar
Dim oHojaActiva As Object
Dim oRango As Object
oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
oRango = oHojaActiva.getCellRangeByName("C6")
'Borramos solo los valores
oRango.clearContents( 7 )
End Sub
Sub CopiarRango_2()
'Parece que copia solo el contenido de la celda
Dim oOrigen As Object
Dim oDestino As Object
'El origen y el destino tienen que ser EXACTAMENTE del mismo tamaño
oOrigen = ThisComponent.Sheets.getByName("INTERFAZ").getCellRangeByName("G1:H1")
oDestino = ThisComponent.Sheets.getByName("BASE").getCellRangeByName("F4:G4")
oDestino.setDataArray( oOrigen.getDataArray )
Call Borrando2
End Sub
Sub CopiarRango_3()
'Parece que copia solo el contenido de la celda
Dim oOrigen As Object
Dim oDestino As Object
'El origen y el destino tienen que ser EXACTAMENTE del mismo tamaño
oOrigen = ThisComponent.Sheets.getByName("INTERFAZ").getCellRangeByName("C6")
oDestino = ThisComponent.Sheets.getByName("BASE").getCellRangeByName("H4")
oDestino.setDataArray( oOrigen.getDataArray )
Call Borrando3
End Sub
Sub CasillasVerificacion()
Dim oFormulario As Object
Dim Casilla_1 As Object
Dim Casilla_2 As Object
oFormulario = ThisComponent.getCurrentController.getActiveSheet.getDrawPage.getForms.getByName( "Formulario" )
Casilla_1 = oFormulario.getByName( "Casilla de verificación 1" )
Casilla_2 = oFormulario.getByName( "Casilla de verificación 2" )
'Alternamos la activación del control
Casilla_1.State = 0
Casilla_2.State = 0
End Sub
La macro para pasar linea de una hoja a otra que vi en otro foro y que adapté a mi necesidad es la siguiente (pero que no me sirve por lo que escribí arriba: COPIA LA CELDA COMPLETA, NECESITO SOLO EL CONTENIDO):
Sub Pasarlinea(HojaOrigen As String, RangoOrigen As String, HojaDestino As String, CeldaDestino As String)
Dim oOrigen As Object
Dim oHojaDestino As Object
Dim oDestino As Object
Dim lFilaLibre As Long
oOrigen = ThisComponent.getSheets.getByName( "INTERFAZ" ).getCellRangeByName( "C6" )
oHojaDestino = ThisComponent.getSheets.getByName( "BASE" )
oDestino = oHojaDestino.getCellRangeByName( "H5" )
lFilaLibre = FilaLibre( oDestino )
oDestino = oHojaDestino.getCellByPosition( oDestino.getRangeAddress.StartColumn, lFilaLibre )
oHojaDestino.copyRange( oDestino.getCellAddress, oOrigen.getRangeAddress )
End Sub
Function FilaLibre( Celda As Object) As Long
Dim oCursor As Object
oCursor = Celda.getSpreadSheet.createCursorByRange( Celda )
If Celda.getString <> "" Then
oCursor.gotoEnd()
FilaLibre = oCursor.getRangeAddress.EndRow + 1
Else
FilaLibre = oCursor.getRangeAddress.EndRow
End If
End Function
Atento a todos sus comentarios,
Editado por el moderador (mauricio) para mover el tema a un subforo apropiado. Si no lo has hecho aún por favor lee la Guía de supervivencia