[RESUELTO] Exportar en PDF el area resaltada en amarillo
Publicado: Mar Abr 11, 2017 9:16 pm
Buenos días a todos
Llevo dias batallando por hacer esto:
En la siguiente hoja de calculo:
solo deseo exportar en PDF el area resaltada en amarillo
en paginas tamaño 4X6 Pulgadas
Pienso que en las siguientes macros, la macro del problema es la que se llama: "Sub Imprimiendo44()"
(¿Que necesito modificar para que mis deseos se hagan realidad? solamente exportar en PDF el area resaltada en amarillo
en paginas tamaño 4X6 Pulgadas)
En caso de no ser posible exportar en PDF en 4X6 pulgadas ya me conformo con que solo las celdas seleccionadas sean exportadas a PDF y que "ocupen toda la pagina"
Adjunto 2 pdf creo que los nombres de los pdf son muy descriptivos.
Este es el codigo que estoy usando:
Llevo dias batallando por hacer esto:
En la siguiente hoja de calculo:
solo deseo exportar en PDF el area resaltada en amarillo
en paginas tamaño 4X6 Pulgadas
Pienso que en las siguientes macros, la macro del problema es la que se llama: "Sub Imprimiendo44()"
(¿Que necesito modificar para que mis deseos se hagan realidad? solamente exportar en PDF el area resaltada en amarillo
en paginas tamaño 4X6 Pulgadas)
En caso de no ser posible exportar en PDF en 4X6 pulgadas ya me conformo con que solo las celdas seleccionadas sean exportadas a PDF y que "ocupen toda la pagina"
Adjunto 2 pdf creo que los nombres de los pdf son muy descriptivos.
Este es el codigo que estoy usando:
Código: Seleccionar todo
Option Explicit
'http://oooug.jp/faq/index.php?faq%2F4b%2F1069
Sub ExportarPDF()
Dim oDoc As Object
Dim mOpciones(0) As New "com.sun.star.beans.PropertyValue"
Dim sRuta As String
Dim oHojaActiva As Object
Dim sValor As String
Dim sRutaURL As String
Dim sRutaCompleta As String
Dim oCelda As Object
Dim sNombre As String
Dim Rangos As String
Dim Nombre_Final As String
Dim mAI(2) As New com.sun.star.table.CellRangeAddress
GlobalScope.BasicLibraries.LoadLibrary( "Tools" )
'Referencia al documento desde donde se llama la macro
oDoc = ThisComponent
Call BorrarAreasImpresion( oDoc )
'CONSTRUIMOS EL DIRECTORIO DONDE ESTA GUARDADA LA HOJA DE CALCULO
'Referencia al documento activo
sRutaURL = ThisComponent.getURL()
'Convertimos la ruta URL en formato local
sRutaCompleta = ConvertFromUrl( sRutaURL )
'Obtenemos solo el nombre del archivo
sNombre = FileNameOutOfPath( sRutaURL )
'Obtenemos el directorio donde esta el archivo
sRuta = DirectoryNameoutofPath(sRutaCompleta, GetPathSeparator())
'SELECCIONAMOS CELDAS A IMPRIMIR
'Rango "U1:AC57"
mAI(0).Sheet = 0
mAI(0).StartColumn = 0
mAI(0).StartRow = 0
mAI(0).EndColumn = 15
mAI(0).EndRow = 28
'Agregamos las áreas de impresión
ThisComponent.getCurrentController.getActiveSheet.setPrintAreas( mAI() )
Call Imprimiendo44()
'CONTRUIMOS EL NOMBRE DE ARCHIVO
'Referencia a la hoja activa
oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
'Referencia a la celda B4
oCelda = oHojaActiva.getcellRangeByName( "B4" )
sValor = oCelda.getString()
sValor = CStr(sValor)
Nombre_Final = Join( split( sValor,"/"),"_",)
'Establecemos el tipo de filtro
mOpciones(0).Name = "FilterName"
'Construimos el filtro correcto PDF para cada aplicacion
mOpciones(0).Value = LCase("Calc") & "_pdf_Export"
sRuta = ConvertToUrl(sRuta & "/" & Nombre_Final) & ".pdf"
'Guardamos el archivo
oDoc.storeToURL( sRuta, mOpciones() )
End Sub
Sub Imprimiendo44()
'Matriz para las opciones de impresión
Dim mOpc(2) As New com.sun.star.beans.PropertyValue
Dim mDI(2) As New com.sun.star.beans.PropertyValue
Dim PaperSize as New com.sun.star.awt.Size
mDI(0).Name = "Name"
mDI(0).Value = "cups-pdf"
mDI(1).Name = "PaperOrientation"
mDI(1).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
PaperSize.Width = 10240
PaperSize.Height = 6000
mDI(2).Name = "PaperSize"
mDI(2).Value = com.sun.star.view.PaperFormat.USER
' ThisComponent.setPrinter( mDI )
'El número de copias
mOpc(0).Name = "CopyCount"
mOpc(0).Value = 1
'Si se imprimen en juegos
mOpc(1).Name = "Collate"
mOpc(1).Value = True
'Las páginas a imprimir
mOpc(2).Name = "Pages"
mOpc(2).Value = "1"
' thisComponent.Print( mOpc() )
End Sub
'Macro para borrar todas las áreas de impresión del archivo
Sub BorrarAreasImpresion( Archivo As Object)
Dim oHoja As Object
For Each oHoja In Archivo.Sheets
oHoja.setPrintAreas( Array() )
Next
End Sub