** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - Pasar useform a pdf
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Pasar useform a pdf

 Responder Responder
Autor
Mensaje
juan carlos 1978 Ver desplegable
Nuevo
Nuevo


Unido: 01/Abril/2020
Localización: tarragona
Estado: Sin conexión
Puntos: 1
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita juan carlos 1978 Cita  ResponderRespuesta Enlace directo a este mensaje 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
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5632
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita AnSanVal Cita  ResponderRespuesta Enlace directo a este mensaje 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
Aprendemos intentando resolver dudas ajenas (ayuda cuando puedas/sepas).

Mi sitio_web con ejemplos Excel.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable