Guardar en PDF solo lo impreso

Discute sobre la aplicación de hojas de cálculo
Responder
ugab
Mensajes: 141
Registrado: Mar May 17, 2011 9:46 pm

Guardar en PDF solo lo impreso

Mensaje por ugab »

Buenas tardes, tengo una planilla de pedido por la cual mediante macros hace diferentes cosas, una de ellas es imprimir solo la zona que deseo pero también a su vez deseo que guarde en pdf solo lo impreso y no lo logro. Les paso la macro que tengo armada, me guarda todas las hojas.
sub Impresion
rem -----------------------------------------------------------------------------------


Dim Clave As Integer
Dim Usuario As String


Clave = InputBox( "Ingrese clave" ) ' PEDIDO DE LA CLAVE PARA LA IMPRESION DEL RECIBO

If Clave = 9999 Then
Usuario = "Marcelo"
ElseIf Clave = 2 Then
Usuario = "Flores"
ElseIf Clave = 3 Then
Usuario = "Renato"
ElseIf Clave = 4 Then
Usuario = "Javier"
ElseIf Clave = 5 Then
Usuario = "Barreiro"
ElseIf Clave = 6 Then
Usuario = "Esteban"
ElseIf Clave = 7 Then
Usuario = "Diego"
ElseIf Clave = 8 Then
Usuario = "Pablo"
ElseIf Clave = 9 Then
Usuario = "Ingadir"
Else
MsgBox "Clave Inválida, repita el procedimiento", 16
Stop
End If

Dim oDocument As Object, oSheet As Object, oCell As Object
Dim folio As String
Dim foparam As String
oDocument=ThisComponent
oSheet = oDocument.CurrentController.getActiveSheet
oCell=oSheet.getCellByPosition(38,100) 'AM101' - TOMO EL FOLIO DE LA BOLETA DEL LOCAL
folio=oCell.getValue
rem print folio

if folio = 0 Then 'SI EL FOLIO ES CERO BOLETA NUEVA, SUMO UNO A LA ULTIMA PARA ASIGNAR LA NUEVA

Dim oDBC As Object
Dim oBD As Object
Dim oConexion As Object
Dim oDeclaracion As Object
Dim oDeclaracion1 As Object
Dim oResultado As Object
Dim sBaseDatos As String
Dim sSQL As String
Dim sSQl1 As String

'El nombre de la base de datos
sBaseDatos = "Parko"
sSQL = "SELECT ARITMO FROM TablaF WHERE ID = 0"
'Creamos el servicio para acceder y manipular las bases de datos
oDBC = createUnoService("com.sun.star.sdb.DatabaseContext")
'Nos aseguramos de que exista la base de datos
If oDBC.hasByName( sBaseDatos ) Then
'Si existe, accedemos por el nombre
oBD = oDBC.getByName( sBaseDatos )
'Creamos una conexion a la base de datos
oConexion = oBD.getConnection("","")
'Creamos un objeto para las instrucciones SQL
oDeclaracion = oConexion.createStatement()
'Ejecutamos la consulta
oResultado = oDeclaracion.executeQuery( sSQL)
If Not IsNull( oResultado ) Then
Do While oResultado.next
'Mostramos el contenido del campo
oRecibo = oResultado.getString(1)
Loop
End If
End If

oDocument = ThisComponent
oSheet = oDocument.CurrentController.getActiveSheet
oCell=oSheet.getCellByPosition(38,100) 'AM101' - PEGO EL FOLIO EN LA BOLETA
oCell.setValue(oRecibo)

oCell=oSheet.getCellByPosition(40,101) 'AO102' - PEGO EL USUARIO EN LA BOLETA
oCell.setString(Usuario)

sSQL1 = "UPDATE ""TablaF"" SET ""ARITMO"" = ""ARITMO"" + 1 WHERE ""ID""=0"
oDeclaracion1 = oConexion.createStatement()
oDeclaracion1.executeUpdate( sSQL1)

oResultado.close()
oDeclaracion.close()
oDeclaracion1.close()
oConexion.close()
oDeclaracion = Nothing
oDeclaracion1 = Nothing
oConexion = Nothing
oResultado = Nothing


rem - FILTADO PARA ELIMINAR RENGLONES EN BLANCO

oHojaRC = ThisComponent.getCurrentController.getActiveSheet()
oRangoCeldas = oHojaRC.getCellRangeByName("B141:H162")
oDescFiltro = oRangoCeldas.createFilterDescriptor (True)
dim oCamposFiltro(0) as new com.sun.star.sheet.TableFilterField
oCamposFiltro(0).Field = 6
oCamposFiltro(0).IsNumeric = True
oCamposFiltro(0).Operator = com.sun.star.sheet.FilterOperator.NOT_EQUAL
oCamposFiltro(0).NumericValue = 0
oDescFiltro.ContainsHeader=False
oDescFiltro.setFilterFields (oCamposFiltro())
oRangoCeldas.filter (oDescFiltro)

oHojaRC2 = ThisComponent.getCurrentController.getActiveSheet()
oRangoCeldas2 = oHojaRC2.getCellRangeByName("B166:H185")
oDescFiltro2 = oRangoCeldas2.createFilterDescriptor (True)
dim oCamposFiltro2(0) as new com.sun.star.sheet.TableFilterField
oCamposFiltro2(0).Field = 6
oCamposFiltro2(0).IsNumeric = True
oCamposFiltro2(0).Operator = com.sun.star.sheet.FilterOperator.NOT_EQUAL
oCamposFiltro2(0).NumericValue = 0
oDescFiltro2.ContainsHeader=False
oDescFiltro2.setFilterFields (oCamposFiltro2())
oRangoCeldas2.filter (oDescFiltro2)

rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")


rem ----------------------------------------------------------------------
rem BORRADO DEL CONTENIDO DE LA BOLETA PREVIO AL COPIADO

dim delargs1(0) as new com.sun.star.beans.PropertyValue
delargs1(0).Name = "ToPoint"
delargs1(0).Value = "$AA$104:$AO$123"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, delargs1())

rem ----------------------------------------------------------------------
dim delargs2(0) as new com.sun.star.beans.PropertyValue
delargs2(0).Name = "Flags"
delargs2(0).Value = "A"

dispatcher.executeDispatch(document, ".uno:Delete", "", 0, delargs2())

dim delargs3(0) as new com.sun.star.beans.PropertyValue
delargs3(0).Name = "ToPoint"
delargs3(0).Value = "$AA$124:$AH$125"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, delargs3())

rem ----------------------------------------------------------------------
dim delargs4(0) as new com.sun.star.beans.PropertyValue
delargs4(0).Name = "Flags"
delargs4(0).Value = "A"

dispatcher.executeDispatch(document, ".uno:Delete", "", 0, delargs4())

rem ----------------------------------------------------------------------

rem COPIA DE LA COLUMNA DE LA IZQUIERDA
dim cargs1(0) as new com.sun.star.beans.PropertyValue
cargs1(0).Name = "ToPoint"
cargs1(0).Value = "$B$141:$I$162"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, cargs1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim cargs3(0) as new com.sun.star.beans.PropertyValue
cargs3(0).Name = "ToPoint"
cargs3(0).Value = "$AA$104" ' LUGAR DONDE INSERTA

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, cargs3())

rem ----------------------------------------------------------------------
dim cargs4(5) as new com.sun.star.beans.PropertyValue
cargs4(0).Name = "Flags"
cargs4(0).Value = "SVDNT"
cargs4(1).Name = "FormulaCommand"
cargs4(1).Value = 0
cargs4(2).Name = "SkipEmptyCells"
cargs4(2).Value = false
cargs4(3).Name = "Transpose"
cargs4(3).Value = false
cargs4(4).Name = "AsLink"
cargs4(4).Value = false
cargs4(5).Name = "MoveMode"
cargs4(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, cargs4())

rem ----------------------------------------------------------------------
rem COPIA DE LA COLUMNA DE LA DERECHA
dim cargs5(0) as new com.sun.star.beans.PropertyValue
cargs5(0).Name = "ToPoint"
cargs5(0).Value = "B166:H185"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, cargs5())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim cargs7(0) as new com.sun.star.beans.PropertyValue
cargs7(0).Name = "ToPoint"
cargs7(0).Value = "$AI$104" ' LUGAR DONDE INSERTA

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, cargs7())

rem ----------------------------------------------------------------------
dim cargs8(5) as new com.sun.star.beans.PropertyValue
cargs8(0).Name = "Flags"
cargs8(0).Value = "SVDNT"
cargs8(1).Name = "FormulaCommand"
cargs8(1).Value = 0
cargs8(2).Name = "SkipEmptyCells"
cargs8(2).Value = false
cargs8(3).Name = "Transpose"
cargs8(3).Value = false
cargs8(4).Name = "AsLink"
cargs8(4).Value = false
cargs8(5).Name = "MoveMode"
cargs8(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, cargs8())

Endif

rem ELIMINA los FILTROS
Dim oFilterDesc ' Filter descriptor.
oFilterDesc = oSheet.createFilterDescriptor(True)
oSheet.filter(oFilterDesc)

rem IMPRESION ----------------------------------------------

rem define variables
rem dim document as object
rem dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "$AA$96:$AO$125" ' AREA IMPRESION DEL RECIBO

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

rem ----------------------------------------------------------------------
dim args6(1) as new com.sun.star.beans.PropertyValue
args6(0).Name = "Copies"
args6(0).Value = 2
args6(1).Name = "Collate"
args6(1).Value = true

dispatcher.executeDispatch(document, ".uno:Print", "", 0, args6())


rem GUARDA EL PDF--------------------------------------------------------
oSheet = ThisComponent.CurrentController.getActiveSheet
recibo = oSheet.getCellRangeByName("AG104").value
dia = day(date)
mes = month(date)
ano = year(date)
hora = time
dim opdf1(3) as new com.sun.star.beans.PropertyValue
opdf1(0).Name = "URL"
opdf1(0).Value = "file:///C:/DATOS/Parque/PDF/" & "Planilla" & dia & "-" & mes & "-" & ano & "-" & recibo & ".pdf"
opdf1(1).Name = "FilterName"
opdf1(1).Value = "calc_pdf_Export"
opdf1(2).Name = "FilterData"
opdf1(2).Value = Array(Array("UseLosslessCompression",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Quality",0,90,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ReduceImageResolution",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("MaxImageResolution",0,300,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("UseTaggedPDF",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("SelectPdfVersion",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportNotes",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportBookmarks",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("OpenBookmarkLevels",0,-1,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("UseTransitionEffects",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("IsSkipEmptyPages",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("IsAddStream",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("FormsType",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportFormFields",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("HideViewerToolbar",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("HideViewerMenubar",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("HideViewerWindowControls",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ResizeWindowToInitialPage",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("CenterWindow",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("OpenInFullScreenMode",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("DisplayPDFDocumentTitle",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("InitialView",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Magnification",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Zoom",0,100,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PageLayout",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("FirstPageOnLeft",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("InitialPage",0,1,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Printing",0,2,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Changes",0,4,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("EnableCopyingOfContent",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("EnableTextAccessForAccessibilityTools",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportLinksRelativeFsys",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PDFViewSelection",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ConvertOOoTargetToPDFTarget",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportBookmarksToPDFDestination",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("_OkButtonString",0,"",com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("EncryptFile",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("DocumentOpenPassword",0,"",com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("RestrictPermissions",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PermissionPassword",0,"",com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("",0,,com.sun.star.beans.PropertyState.DIRECT_VALUE))
opdf1(3).Name = "SelectionOnly"
opdf1(3).Value = False

dispatcher.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, opdf1())
dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array())

Espero alguien pueda ayudarme
Gracias
OpenOffice 4.1.5 en Windows 10 - Ubuntu
ugab
Mensajes: 141
Registrado: Mar May 17, 2011 9:46 pm

Re: Guardar en PDF solo lo impreso

Mensaje por ugab »

Les hago otra consulta deseo adjuntar la planilla y es muy grande su tamaño, como puedo hacer para adjuntarla.
Desde ya muchas gracias
OpenOffice 4.1.5 en Windows 10 - Ubuntu
Neftali R
Mensajes: 169
Registrado: Mar Jun 15, 2021 12:48 pm
Ubicación: Venezuela

Re: Guardar en PDF solo lo impreso

Mensaje por Neftali R »

Puedes subir la planilla en google drive, mega, o cualquier otro servicio que guarde archivos en internet y compartir el link para descargar la planilla en le foro.
LibreOffice 7.2.6.2 | Windows 7 Ultimate
ugab
Mensajes: 141
Registrado: Mar May 17, 2011 9:46 pm

Re: Guardar en PDF solo lo impreso

Mensaje por ugab »

OpenOffice 4.1.5 en Windows 10 - Ubuntu
Responder