Página 1 de 1

Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Jue Ago 16, 2018 9:42 pm
por Andres Lote
Buenas tardes para todos,

Agradezco de su colaboración para la siguiente inquietud, deseo exportar la información que se encuentra en la hoja "BASE DE DATOS" del rango A4:C1048576 del libro "pasarDatos" y hacer que este contenido se copie a otro libro al cual llamare "Informe", he buscado el método pero no he encontrado la solución para esta igconita, de antemano agradezco de su colaboración.

Saludos :D :D :D

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Vie Ago 17, 2018 3:52 am
por FJCC-ES
Este código copia el DataArray de las celdas en la hoja Base De Datos hasta la hoja Sheet1 del archivo Informe.ods.
(Primero borré los ceros en las celdas 'Base De Datos'.A1:A3)

Código: Seleccionar todo

doc = ThisComponent
fuente = doc.Sheets.getByName("Base de datos")
arranque = fuente.getCellRangeByName("A4")
cursor = fuente.createCursorByRange(arranque)
cursor.collapseToCurrentRegion
EndRow = cursor.RangeAddress.EndRow
DataArrayFuente = cursor.DataArray

URL = convertToURL("c:\users\fjcc\Desktop\Informe.ods")
Informe = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Array())
oSheet1 = Informe.Sheets.getByName("Sheet1")
oCellRange = oSheet1.getCellRangeByPosition(0,0,2,EndRow - 3)
oCellRange.DataArray = DataArrayFuente

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Vie Ago 17, 2018 5:53 pm
por Andres Lote
Buenas tardes,

Agradezco de su ayuda FJCC-ES; sin embargo, tome el código y lo puse en prueba en el siguiente archivo pero aparece el siguiente error :

"Error de ejecución de BASIC.
Se ha producido una excepción
Type: com.sun.star.uno.RuntimeException
Message: ."

Aclaro que la información que deseo copiar se encuentra desde la celda D4 en adelante pero no se cual es el problema, agradezco de su ayuda adjunto archivo.

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Vie Ago 17, 2018 7:28 pm
por FJCC-ES
Los datos en el archivo pasarDatos están en las columnas A:C. El código supone esto en la linea

Código: Seleccionar todo

oCellRange = oSheet1.getCellRangeByPosition(0,0,2,EndRow – 3)
.
Los Datos en el archivo Base.ods ocupan las columnas A:AL. Esta versión de la macro no supone que las datos están en columnas fijas.

Código: Seleccionar todo

doc = ThisComponent
fuente = doc.Sheets.getByName("Base_Agendados")
arranque = fuente.getCellRangeByName("D4")
cursor = fuente.createCursorByRange(arranque)
cursor.collapseToCurrentRegion
EndRow = cursor.RangeAddress.EndRow
EndColumn = cursor.RangeAddress.EndColumn
DataArrayFuente = cursor.DataArray

URL = convertToURL("/home/fjcc/Documents/Informe.ods")
Informe = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Array())
oSheet1 = Informe.Sheets.getByName("Sheet1")
oCellRange = oSheet1.getCellRangeByPosition(0,0,EndColumn,EndRow - 3)
oCellRange.DataArray = DataArrayFuente

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Mié Ago 22, 2018 5:43 pm
por Andres Lote
Buenas tardes FJCC-ES,

Gracias por la ayuda suministrada; sin embargo, tengo otra consulta lo que sucede es que el archivo, se va a repartir a varias personas lo que tocaría estar cambiando la ruta a cada uno de los equipos para que esta ejecute correctamente, me gustaría saber si es posible que en vez de que se realice este cambio en la macro, mas bien la macro pregunte el lugar en donde desea guardar los cambios, he visto que es posible con el siguiente código pero no entiendo como acoplarlo en la macro que me suministro.

Sub GuardarArchivo2()
Dim oDlgCarpeta as Object
Dim sRuta As String
Dim oHoja As Object
Dim oCelda As Object
Dim mOpciones(0) As New "com.sun.star.beans.PropertyValue"

'Servicio para seleccionar una ruta, solo la carpeta
oDlgCarpeta = CreateUnoService ("com.sun.star.ui.dialogs.FolderPicker")

With oDlgCarpeta
'El título del cuadro de diálogo
.Title = "Selecciona el directorio donde guardar el nuevo archivo"
'El directorio predeterminado, si usas Windows puede ser D:\Mis documentos
.DisplayDirectory = ConvertToUrl("/home/mau")
End With

'Lo mostramos
If oDlgCarpeta.Execute() Then
'Obtenemos la ruta seleccionada por el usuario
sRuta = oDlgCarpeta.Directory
'La hoja donde se tomara el dato para el nombre del archivo
oHoja = ThisComponent.getSheets().getByName("Hoja1")
oCelda = oHoja.getCellRangeByName("A1")
'Construimos la ruta completa
sRuta = sRuta & "/" & oCelda.getString() & ".ODS"
'Guardamos el archivo
ThisComponent.storeAsURL( sRuta, mOpciones() )
MsgBox "Archivo guardado correctamente"
Else
MsgBox "Proceso cancelado"
End If

End Sub

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Jue Ago 23, 2018 3:49 am
por FJCC-ES
No entiendo exactamente que quiere que selecciona el usuario. ¿La carpeta donde está guardado Informe.ods o la carpeta donde se va a guardar Informe.ods después de copiar los datos de Base.ods? Esta macro abre Informe.ods, pega los datos de Base.ods, pregunta donde guardar el archivo y guarda una copia en esa carpeta.

Código: Seleccionar todo

doc = ThisComponent
fuente = doc.Sheets.getByName("Base_Agendados")
arranque = fuente.getCellRangeByName("D4")
cursor = fuente.createCursorByRange(arranque)
cursor.collapseToCurrentRegion
EndRow = cursor.RangeAddress.EndRow
EndColumn = cursor.RangeAddress.EndColumn
DataArrayFuente = cursor.DataArray

URL = convertToURL("/home/fjcc/Documents/Informe.ods")
Informe = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Array())
oSheet1 = Informe.Sheets.getByName("Sheet1")
oCellRange = oSheet1.getCellRangeByPosition(0,0,EndColumn,EndRow - 3)
oCellRange.DataArray = DataArrayFuente
'######################
Dim mOpciones(0) As New "com.sun.star.beans.PropertyValue"

'Servicio para seleccionar una ruta, solo la carpeta
oDlgCarpeta = CreateUnoService ("com.sun.star.ui.dialogs.FolderPicker")

With oDlgCarpeta
'El título del cuadro de diálogo
.Title = "Selecciona el directorio donde guardar el nuevo archivo"
'El directorio predeterminado, si usas Windows puede ser D:\Mis documentos
'.DisplayDirectory = ConvertToUrl("/home/mau") 'fjcc ##########
End With

'Lo mostramos
If oDlgCarpeta.Execute() Then
'Obtenemos la ruta seleccionada por el usuario
sRuta = oDlgCarpeta.Directory
'La hoja donde se tomara el dato para el nombre del archivo
'oHoja = ThisComponent.getSheets().getByName("Hoja1")  'FJCC ###########
'oCelda = oHoja.getCellRangeByName("A1")  'FJCC ###########
'Construimos la ruta completa
sRuta = sRuta & "/" & "Informe.ods" 'fjcc ##############
'Guardamos el archivo
Informe.storeToURL( sRuta, mOpciones() )  'Guardar Copia, storeToURL en vez de storeAsURL  FJCC ##############
MsgBox "Archivo guardado correctamente"
Else
MsgBox "Proceso cancelado"
End If

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Jue Ago 23, 2018 6:28 pm
por Andres Lote
Buenas tardes,

Lo que necesito es que el usuario seleccione la carpeta donde se va a guardar Informe.ods después de copiar los datos de Base.ods, y una vez haya escogido la ruta la guarde con el nombre que desee.

Gracias.... :D

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Jue Ago 23, 2018 7:04 pm
por FJCC-ES

Código: Seleccionar todo

doc = ThisComponent
fuente = doc.Sheets.getByName("Base_Agendados")
arranque = fuente.getCellRangeByName("D4")
cursor = fuente.createCursorByRange(arranque)
cursor.collapseToCurrentRegion
EndRow = cursor.RangeAddress.EndRow
EndColumn = cursor.RangeAddress.EndColumn
DataArrayFuente = cursor.DataArray

URL = convertToURL("/home/fjcc/Documents/Informe.ods")
Informe = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Array())
oSheet1 = Informe.Sheets.getByName("Sheet1")
oCellRange = oSheet1.getCellRangeByPosition(0,0,EndColumn,EndRow - 3)
oCellRange.DataArray = DataArrayFuente
'######################
Dim mOpciones(0) As New "com.sun.star.beans.PropertyValue"

'Servicio para seleccionar una ruta, solo la carpeta
oDlgCarpeta = CreateUnoService ("com.sun.star.ui.dialogs.FolderPicker")

With oDlgCarpeta
'El título del cuadro de diálogo
.Title = "Selecciona el directorio donde guardar el nuevo archivo"
'El directorio predeterminado, si usas Windows puede ser D:\Mis documentos
'.DisplayDirectory = ConvertToUrl("/home/mau") 'fjcc ##########
End With

'Lo mostramos
If oDlgCarpeta.Execute() Then
'Obtenemos la ruta seleccionada por el usuario
sRuta = oDlgCarpeta.Directory
'La hoja donde se tomara el dato para el nombre del archivo
'oHoja = ThisComponent.getSheets().getByName("Hoja1")  'FJCC ###########
'oCelda = oHoja.getCellRangeByName("A1")  'FJCC ###########
'Construimos la ruta completa
Nombre = InputBox("Nombre del archivo")
If Right(Nombre, 4) <> ".ods" Then
	Nombre = Nombre & ".ods"
End If
sRuta = sRuta & "/" & Nombre 'fjcc ##############
'Guardamos el archivo
Informe.storeToURL( sRuta, mOpciones() )  'Guardar Copia, storeToURL en vez de storeAsURL  FJCC ##############
MsgBox "Archivo guardado correctamente"
Else
MsgBox "Proceso cancelado"
End If

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Vie Ago 24, 2018 10:49 pm
por Andres Lote
Discúlpeme si tal vez no he sido claro, lo que quiero es que después de copiar la información de la base.ods, se cree un nuevo archivo y hay se copie la información seleccionada de la base.ods, luego salga un mensaje en el cual solicite en donde desea guardar el archivo con la ubicación y nombre que desee el usuario.

Para evitar usar esta parte:

URL = convertToURL("/home/fjcc/Documents/Informe.ods")
Informe = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Array())
oSheet1 = Informe.Sheets.getByName("Sheet1")
oCellRange = oSheet1.getCellRangeByPosition(0,0,EndColumn,EndRow - 3)
oCellRange.DataArray = DataArrayFuente

Ya que como el archivo se va a compartir con varios usuarios y cada computador tiene una ruta distinta, y lo que se requiere es evitar cambiar la ruta ya que son mas de 20 usuarios, gracias.

Re: Copiar un rango de celdas de un libro a otro libro nuevo

Publicado: Sab Ago 25, 2018 1:48 am
por FJCC-ES

Código: Seleccionar todo

doc = ThisComponent
fuente = doc.Sheets.getByName("Base_Agendados")
arranque = fuente.getCellRangeByName("D4")
cursor = fuente.createCursorByRange(arranque)
cursor.collapseToCurrentRegion
EndRow = cursor.RangeAddress.EndRow
EndColumn = cursor.RangeAddress.EndColumn
DataArrayFuente = cursor.DataArray

Informe = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Array()) 'documento nuevo 
oSheet1 = Informe.Sheets.getByIndex(0) 'la primera hoja 
oCellRange = oSheet1.getCellRangeByPosition(0,0,EndColumn,EndRow - 3) 'Definimos un rango de celdas con el tamaño del cursor
oCellRange.DataArray = DataArrayFuente    'copiar los datos

Dim mOpciones(0) As New "com.sun.star.beans.PropertyValue"

'Servicio para seleccionar una ruta, solo la carpeta
oDlgCarpeta = CreateUnoService ("com.sun.star.ui.dialogs.FolderPicker")

With oDlgCarpeta
'El título del cuadro de diálogo
.Title = "Selecciona el directorio donde guardar el nuevo archivo"
'El directorio predeterminado, si usas Windows puede ser D:\Mis documentos
'.DisplayDirectory = ConvertToUrl("/home/mau") 
End With

'Lo mostramos
If oDlgCarpeta.Execute() Then
'Obtenemos la ruta seleccionada por el usuario
sRuta = oDlgCarpeta.Directory

'Construimos la ruta completa
Nombre = InputBox("Nombre del archivo") 'preguntar por el nombre
If Right(Nombre, 4) <> ".ods" Then
	Nombre = Nombre & ".ods"
End If
sRuta = sRuta & "/" & Nombre
'Guardamos el archivo
Informe.storeAsURL( sRuta, mOpciones() )  'Guardar   
'Informe.close(TRUE) 'si quiere cerrar el documento.
MsgBox "Archivo guardado correctamente"
Else
MsgBox "Proceso cancelado"
End If