Saltar al contenido

Guardar archivo en pdf y con el nombre del caption de un label


Recommended Posts

Buenos dias 

Tengo una rutina que me guarda los datos de un formulario a dos hojas excel dentro del mismo libro y necesitaría que en esa misma rutina me creara un archivo pdf con  el nombre del label "lb_parte"

Private Sub Imprimirparte2()
Dim final As Long
Dim fila As Integer
With ThisWorkbook

 
        
       
       .Sheets("PARTE DE TRABAJO").Range("r2").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("d2").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("g2").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("l2").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("c3:o4").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("b8").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("b10").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("b12").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("L6:L12").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("O6:O13").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("t12:u13").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("a18:a30").ClearContents
       .Sheets("PARTE DE TRABAJO").Range("j18:j30").ClearContents
       .Sheets("CHECKLIST PAR").Range("apar").ClearContents
        fila = 18

        final = .Sheets("PARTE DE TRABAJO").Cells(Rows.Count, 1).End(3).Row + 1
        

final = fila


                .Sheets("PARTE DE TRABAJO").Range("D2").Value = Me.cbo_not
                .Sheets("PARTE DE TRABAJO").Range("r2").Value = Me.lb_parte
                .Sheets("CHECKLIST PAR").Range("T3").Value = Me.cbo_not
                .Sheets("CHECKLIST PAR").Range("T1").Value = Me.lb_parte
                .Sheets("PARTE DE TRABAJO").Range("C3").Value = Me.txt_descrip
                .Sheets("PARTE DE TRABAJO").Range("G2").Value = Me.txt_fecha
                .Sheets("PARTE DE TRABAJO").Range("L2").Value = Me.cbo_equipo
                .Sheets("PARTE DE TRABAJO").Range("B8").Value = Me.eje1
                .Sheets("PARTE DE TRABAJO").Range("B10").Value = Me.eje2
                .Sheets("PARTE DE TRABAJO").Range("B12").Value = Me.eje3
                .Sheets("PARTE DE TRABAJO").Range("T12").Value = Me.TextBox1
                .Sheets("CHECKLIST PAR").Range("T5").Value = Me.txt_fecha
                .Sheets("CHECKLIST PAR").Range("T2").Value = Me.cbo_equipo
                .Sheets("CHECKLIST PAR").Range("D20").Value = Me.eje1
                .Sheets("PARTE DE TRABAJO").Range("L6").Value = Me.ck_brazalete
                .Sheets("PARTE DE TRABAJO").Range("L7").Value = Me.CheckBox2 ' ANTIACIDOS
                .Sheets("PARTE DE TRABAJO").Range("L8").Value = Me.CheckBox3 'TERMICOS
                .Sheets("PARTE DE TRABAJO").Range("L9").Value = Me.CheckBox4 'AGUA
                .Sheets("PARTE DE TRABAJO").Range("L10").Value = Me.CheckBox5 'ESTANCAS
                .Sheets("PARTE DE TRABAJO").Range("L11").Value = Me.CheckBox6 'QUIMICO
                .Sheets("PARTE DE TRABAJO").Range("L12").Value = Me.CheckBox13 ' ARNES
                .Sheets("PARTE DE TRABAJO").Range("O6").Value = Me.CheckBox8 'CHALECO
                .Sheets("PARTE DE TRABAJO").Range("O7").Value = Me.CheckBox9 'PPI
                .Sheets("PARTE DE TRABAJO").Range("O8").Value = Me.CheckBox10 'ABEK
                .Sheets("PARTE DE TRABAJO").Range("O9").Value = Me.CheckBox11 'ERA
                .Sheets("PARTE DE TRABAJO").Range("O10").Value = Me.CheckBox12 'ERSA
                .Sheets("PARTE DE TRABAJO").Range("O11").Value = Me.CheckBox8 'POLVO
                .Sheets("PARTE DE TRABAJO").Range("O12").Value = Me.CheckBox14 ' EXTINTOR
                .Sheets("PARTE DE TRABAJO").Range("O13").Value = Me.CheckBox15 ' EXPLOSIMETRO
                
            For i = 0 To Me.ListBox1.ListCount - 1
                .Sheets("PARTE DE TRABAJO").Cells(final, "A") = Me.ListBox1.List(i, 0) & " " & Me.ListBox1.List(i, 1) ' se tiene que grabar en la celda A18
               ' .Worksheets("Hoja1").Cells(final, "D") = Me.ListBox1.List(i, 1) ' se tiene que grabar en la celda D18
                .Sheets("PARTE DE TRABAJO").Cells(final, "j") = Me.ListBox1.List(i, 9) ' se tiene que grabar en la celda F18
                
                final = final + 1
            Next
            final = 41
'
           For J = 0 To Me.ListBox2.ListCount - 1
                .Sheets("PARTE DE TRABAJO").Cells(final, "H") = Me.ListBox2.List(J, 0)    ' se tiene que grabar en la celda N42
                .Sheets("PARTE DE TRABAJO").Cells(final, "N") = Me.ListBox2.List(J, 1)    ' se tiene que grabar en la celda P42
                final = final + 1
            Next
            
            final = 8
            For i = 0 To Me.ListBox1.ListCount - 1
                .Sheets("CHECKLIST PAR").Cells(final, "a") = Me.ListBox1.List(i, 0) & " " & Me.ListBox1.List(i, 1)
                .Sheets("CHECKLIST PAR").Cells(final, "e") = Me.ListBox1.List(i, 2) ' se tiene que grabar en la celda D18
                .Sheets("CHECKLIST PAR").Cells(final, "f") = Me.ListBox1.List(i, 3) ' se tiene que grabar en la celda F18
                .Sheets("CHECKLIST PAR").Cells(final, "g") = Me.ListBox1.List(i, 4)
                .Sheets("CHECKLIST PAR").Cells(final, "h") = Me.ListBox1.List(i, 5)
                .Sheets("CHECKLIST PAR").Cells(final, "i") = Me.ListBox1.List(i, 6)
                .Sheets("CHECKLIST PAR").Cells(final, "p") = Me.ListBox1.List(i, 7)
                .Sheets("CHECKLIST PAR").Cells(final, "r") = Me.ListBox1.List(i, 8)
                
                
                final = final + 1
            Next
 
'Establecer área de impresión y enviar al impresor.

 
.Sheets("PARTE DE TRABAJO").PageSetup.PrintArea = "parte"
.Sheets("PARTE DE TRABAJO").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
.Sheets("CHECKLIST PAR").PageSetup.PrintArea = "apar"
.Sheets("CHECKLIST PAR").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

               
            End With

End Sub

 

Enlace a comentario
Compartir con otras webs

Saludos, supongo que este código puedes añadir para guardar como pdf, usando lo que esté en la label.

archivo = label.caption
ActiveSheet.Range("a1:d20").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\archivo.pdf", quality:=xlQualityStandard, openafterpublish:=True

Debes especificar tu rango

espero que te sirva

Enlace a comentario
Compartir con otras webs

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.