Imprimir página | Cerrar ventana

Pasar useform a pdf

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Excel
Descripción del foro: Foro de Excel y VBA de Excel
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=85112
Fecha de impresión: 28/Marzo/2024 a las 12:40


Tema: Pasar useform a pdf
Publicado por: juan carlos 1978
Asunto: Pasar useform a pdf
Fecha de publicación: 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



Respuestas:
Publicado por: AnSanVal
Fecha de publicación: 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) <> ""





-------------
Saludos desde Tenerife.



Imprimir página | Cerrar ventana