Pasar useform a pdf

   BUenos dias Tengo un codigo que me pasa los datos de un formulario a una hoja excel , pero me gustaria que se convirtiera directamente en pdf.

espero me pueden ayudar.

Private Sub Imprimirparte()
Dim objExcel As Application
Dim RutaArchivo As String
Dim Texto As String
Dim Fila As Integer

Set objExcel = CreateObject("Excel.Application")

With objExcel

    RutaArchivo = ThisWorkbook.Path & "\parte_tmp.xlsx"

    If IsFileOpen(RutaArchivo) Then
            MsgBox "El libro debe estar cerrado para proceder."
            Exit Sub
    Else

     With .Workbooks.Open(RutaArchivo)

       .Worksheets("Hoja1").Range("parte").ClearContents
       .Worksheets("Hoja2").Range("apar").ClearContents
        Fila = 18

        Do While .Worksheets("Hoja1").Cells(18, 1) <> ""
            Fila = Fila + 1
        Loop

final = Fila

                .Worksheets("Hoja1").Range("D2").Value = Me.cbo_not
                .Worksheets("Hoja2").Range("T3").Value = Me.cbo_not
                .Worksheets("Hoja1").Range("C3").Value = Me.txt_descrip
                .Worksheets("Hoja1").Range("G2").Value = Me.txt_fecha
                .Worksheets("Hoja1").Range("L2").Value = Me.txt_equipo
                .Worksheets("Hoja1").Range("B8").Value = Me.eje1
                .Worksheets("Hoja1").Range("B10").Value = Me.eje2
                .Worksheets("Hoja1").Range("B12").Value = Me.eje3
                .Worksheets("Hoja2").Range("T5").Value = Me.txt_fecha
                .Worksheets("Hoja2").Range("T2").Value = Me.txt_equipo
                .Worksheets("Hoja2").Range("D20").Value = Me.eje1

            For i = 0 To Me.ListBox1.ListCount - 1
                .Worksheets("Hoja1").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
                .Worksheets("Hoja1").Cells(final, "F") = Me.ListBox1.List(i, 9) ' se tiene que grabar en la celda F18

                final = final + 1
            Next
            final = 42
'
           For J = 0 To Me.ListBox2.ListCount - 1
                .Worksheets("Hoja1").Cells(final, "H") = Me.ListBox2.List(J, 0)    ' se tiene que grabar en la celda N42
                .Worksheets("Hoja1").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
                .Worksheets("Hoja2").Cells(final, "a") = Me.ListBox1.List(i, 0) & " " & Me.ListBox1.List(i, 1)
                .Worksheets("Hoja2").Cells(final, "e") = Me.ListBox1.List(i, 2) ' se tiene que grabar en la celda D18
                .Worksheets("Hoja2").Cells(final, "f") = Me.ListBox1.List(i, 3) ' se tiene que grabar en la celda F18
                .Worksheets("Hoja2").Cells(final, "g") = Me.ListBox1.List(i, 4)
                .Worksheets("Hoja2").Cells(final, "h") = Me.ListBox1.List(i, 5)
                .Worksheets("Hoja2").Cells(final, "i") = Me.ListBox1.List(i, 6)
                .Worksheets("Hoja2").Cells(final, "p") = Me.ListBox1.List(i, 7)
                .Worksheets("Hoja2").Cells(final, "r") = Me.ListBox1.List(i, 8)
               ' .Worksheets("Hoja2").Cells(final, "r") = Me.ListBox1.List(i, 9)
               ' .Worksheets("Hoja2").Cells(final, "s") = Me.ListBox1.List(i, 9)

                final = final + 1
            Next

'Establecer área de impresión y enviar al impresor.

.Worksheets("Hoja1").PageSetup.PrintArea = "parte"
.Worksheets("Hoja1").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
.Worksheets("Hoja2").PageSetup.PrintArea = "apar"
.Worksheets("Hoja2").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

                .Close SaveChanges:=True
            End With
        End If
    .Quit
End With

End Sub

Autor	Mensaje Tema Buscar Opciones del Tema Responder Crear un nuevo tema Versión imprimible Traducir Tema
juan carlos 1978 Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Nuevo Unido: 01/Abril/2020 Localización: tarragona Estado: Sin conexión Puntos: 1	Tema: Pasar useform a pdf Enviado: 01/Abril/2020 a las 15:05
	BUenos dias Tengo un codigo que me pasa los datos de un formulario a una hoja excel , pero me gustaria que se convirtiera directamente en pdf. espero me pueden ayudar. Private Sub Imprimirparte() Dim objExcel As Application Dim RutaArchivo As String Dim Texto As String Dim Fila As Integer Set objExcel = CreateObject("Excel.Application") With objExcel RutaArchivo = ThisWorkbook.Path & "\parte_tmp.xlsx" If IsFileOpen(RutaArchivo) Then MsgBox "El libro debe estar cerrado para proceder." Exit Sub Else With .Workbooks.Open(RutaArchivo) .Worksheets("Hoja1").Range("parte").ClearContents .Worksheets("Hoja2").Range("apar").ClearContents Fila = 18 Do While .Worksheets("Hoja1").Cells(18, 1) <> "" Fila = Fila + 1 Loop final = Fila .Worksheets("Hoja1").Range("D2").Value = Me.cbo_not .Worksheets("Hoja2").Range("T3").Value = Me.cbo_not .Worksheets("Hoja1").Range("C3").Value = Me.txt_descrip .Worksheets("Hoja1").Range("G2").Value = Me.txt_fecha .Worksheets("Hoja1").Range("L2").Value = Me.txt_equipo .Worksheets("Hoja1").Range("B8").Value = Me.eje1 .Worksheets("Hoja1").Range("B10").Value = Me.eje2 .Worksheets("Hoja1").Range("B12").Value = Me.eje3 .Worksheets("Hoja2").Range("T5").Value = Me.txt_fecha .Worksheets("Hoja2").Range("T2").Value = Me.txt_equipo .Worksheets("Hoja2").Range("D20").Value = Me.eje1 For i = 0 To Me.ListBox1.ListCount - 1 .Worksheets("Hoja1").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 .Worksheets("Hoja1").Cells(final, "F") = Me.ListBox1.List(i, 9) ' se tiene que grabar en la celda F18 final = final + 1 Next final = 42 ' For J = 0 To Me.ListBox2.ListCount - 1 .Worksheets("Hoja1").Cells(final, "H") = Me.ListBox2.List(J, 0) ' se tiene que grabar en la celda N42 .Worksheets("Hoja1").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 .Worksheets("Hoja2").Cells(final, "a") = Me.ListBox1.List(i, 0) & " " & Me.ListBox1.List(i, 1) .Worksheets("Hoja2").Cells(final, "e") = Me.ListBox1.List(i, 2) ' se tiene que grabar en la celda D18 .Worksheets("Hoja2").Cells(final, "f") = Me.ListBox1.List(i, 3) ' se tiene que grabar en la celda F18 .Worksheets("Hoja2").Cells(final, "g") = Me.ListBox1.List(i, 4) .Worksheets("Hoja2").Cells(final, "h") = Me.ListBox1.List(i, 5) .Worksheets("Hoja2").Cells(final, "i") = Me.ListBox1.List(i, 6) .Worksheets("Hoja2").Cells(final, "p") = Me.ListBox1.List(i, 7) .Worksheets("Hoja2").Cells(final, "r") = Me.ListBox1.List(i, 8) ' .Worksheets("Hoja2").Cells(final, "r") = Me.ListBox1.List(i, 9) ' .Worksheets("Hoja2").Cells(final, "s") = Me.ListBox1.List(i, 9) final = final + 1 Next 'Establecer área de impresión y enviar al impresor. .Worksheets("Hoja1").PageSetup.PrintArea = "parte" .Worksheets("Hoja1").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False .Worksheets("Hoja2").PageSetup.PrintArea = "apar" .Worksheets("Hoja2").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False .Close SaveChanges:=True End With End If .Quit End With End Sub

AnSanVal Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 16/Marzo/2005 Localización: España Estado: Sin conexión Puntos: 5974	Enviado: 01/Abril/2020 a las 20:05
	¿Has probado ese código?. ¡Supongo que no!. No lo he leído todo (no tiene sentido). Por ejemplo; el siguiente código me motivó a NO seguir leyendo: . . . Fila = 18 Do While .Worksheets("Hoja1").Cells(18, 1) <> "" Fila = Fila + 1 Loop final = Fila . . . caso a).- ... si al ejecutarlo, A18 = "", el bucle DO LOOP no se ejecuta y final = 18 (siempre será 18). caso b).- ... si al ejecutarlo, A18 = "algo", el bucle DO LOOP se ejecuta > fila = 19 ... ... A18 no ha cambiado > 2ª vuelta DO LOOP > fila = 20 ... ... A18 no ha cambiado > 3ª vuelta DO LOOP > fila = 21 ... ... A18 no ha cambiado > 4ª vuelta DO LOOP > fila = 22 ... ... A18 no ha cambiado > 5ª vuelta DO LOOP > fila = 23 ... ... ... y el bucle segirá sin fin hasta que se poroduzca desbordamiento. final nunca toma el valor de fila, ==> Sobre tu consulta «... me gustaría que se convirtiera directamente en pdf...», te aconsejo que lo hagas en dos procesos independientes: 1) Trasvase de datos y 2) Crear PDF. Sigas mi consejo o no lo sigas; el código lo puedes obtener de modo eficiente con la GRABADORA de Excel. Editado: Olvidé comentarte que (quizás) te convenga cambiar... Do While .Worksheets("Hoja1").Cells(18, 1) <> "" … por este otro: Do While .Worksheets("Hoja1").Cells(fila, 1) <> "" Editado por AnSanVal - 01/Abril/2020 a las 20:12
	Saludos desde Tenerife.