Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

SALAVERRINO

ANSWERED MACRO PARA GUARDAR PDF

Recommended Posts

Buenas días a los integrantes de esté prestigioso Foro, en esta ocasión recurro a Uds para que me brinde su apoyo al guardar los archivos PDF, la siguiente macro lo encontré en un vídeo de youtube de ExceleInfo, el cual lo adapte a mi requerimiento, pero tengo algunos inconvenientes:

Macro original:

Option Explicit

Sub ElegirAccion()
Dim Elegir As Variant
Dim i As Integer
Dim miArchivo As String
Dim a As String
Dim Ruta As String
Dim intInicial As Integer
Dim intFinal As Integer
Dim intConsecutivo As Integer
Dim srtTitulo As String

srtTitulo = "EXCELeINFO"
intConsecutivo = ThisWorkbook.Sheets("Datos").Range("CONSECUTIVO").Value

Elegir = InputBox("Elige la acción a ejecutar:" & vbNewLine & "1 = Imprimir" & _
vbNewLine & "2 = Guardar en PDF", srtTitulo)

If Elegir <> 1 And Elegir <> 2 Then
    MsgBox "Debe elegir una opción correcta.", vbExclamation, srtTitulo
ElseIf Elegir = 1 Then
    
    intInicial = InputBox("Introduce el ID inicial", srtTitulo)
    intFinal = InputBox("Introduce el ID final", srtTitulo)
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        For i = intInicial To intFinal
            
            ThisWorkbook.Sheets("Imprimir").Range("F4").Value = i
            MsgBox "Imprimiendo ID '" & i & "'. Presione Aceptar para continuar...", vbInformation, srtTitulo
            'ThisWorkbook.ActiveSheet.PrintOut Copies:=1
            
        Next i
    End If
    
ElseIf Elegir = 2 Then
    
    intInicial = InputBox("Introduce el ID inicial", srtTitulo)
    intFinal = InputBox("Introduce el ID final", srtTitulo)
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        'Propiedad FileDialog
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = ActiveWorkbook.Path & " \ "
            .Title = "EXCELeINFO - Seleccionar carpeta"
            .Show
            If .SelectedItems.Count = 0 Then
            Else
                Ruta = .SelectedItems(1)
                For i = intInicial To intFinal
                    
                    ThisWorkbook.Sheets("Imprimir").Range("F4").Value = i
                    
                    MsgBox "Guardando en PDF ID '" & i & "'. Presione Aceptar para continuar...", _
                    vbInformation, srtTitulo
                    
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    Ruta & "\" & i & ".pdf", Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                    
                Next i
            End If
        End With
    End If
End If
    
End Sub

Macro modificada:

Option Explicit
Sub ElegirAccion()
Dim i As Integer
Dim intInicial As Integer
Dim intFinal As Integer
Dim intConsecutivo As Integer
Dim srtTitulo As String
Dim Ruta As String

srtTitulo = "PRUEBITA"
intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value

    intInicial = Sheets("BOLETA PDF").Range("N4")
    intFinal = Sheets("BOLETA PDF").Range("M3")
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = ActiveWorkbook.Path & " \ "
            .Title = "EXCELeINFO - Seleccionar carpeta"
            .Show
            If .SelectedItems.Count = 0 Then
            Else
                Ruta = .SelectedItems(1)
                For i = intInicial To intFinal
                    
                    ThisWorkbook.Sheets("BOLETA PDF").Range("B5").Value = i
                    
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & i & " " & Sheets("BOLETA PDF").Range("I6") & ".pdf", _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
               Next i
            End If
        End With
    End If
End Sub

 

*Al estas en la pestaña BOLETAS PDF y al presionar el botón IMPRIMIR PDF me muestra la carpeta donde se guardara los datos pdf, y lo que quiera es que guarde los pdf sin necesidad que mencione y muestre la carpeta a guardar.

*Luego que se muestra la dirección a guardar los pdf, empiezan a generarse 1 x 1 cada ID (en esta ocasión son 98 registros de los cuales pueden ser más o menos) y lo que requiero es que se guarde en 1 solo archivos los 98 registros.

*También si fuera posible mediante otra macro, en lugar de ir guardando por el ID los 98 registros sea con nombres y apellidos, que se ubican en la celda O4 (opcional).

Adjunto link del archivo: https://drive.google.com/file/d/1ABlsmnrhXwBjLeLwYuTSi0_b1N_qWrqD/view?usp=sharing 

Desde ya agradezco tu apoyo.

Saludos.

Share this post


Link to post
Share on other sites

Propuesta:

Sólo necesitas darle formato y ajustarlo la impresión a tu gusto

Option Explicit
Dim i As Integer
Dim intInicial As Integer
Dim intFinal As Integer
Dim intConsecutivo As Integer
Dim srtTitulo As String
Dim Ruta As String
Dim e As Variant

Sub ElegirAccion()


srtTitulo = "PRUEBITA"
intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value

    intInicial = Sheets("BOLETA PDF").Range("N4")
    intFinal = Sheets("BOLETA PDF").Range("M3")
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        Worksheets.Add.Name = "PDF"
        Sheets("BOLETA PDF").Select
        Ruta = ActiveWorkbook.Path
            
        e = 0
        For i = intInicial To intFinal
            e = e + 87
            ThisWorkbook.Sheets("BOLETA PDF").Range("B5").Value = i
            ThisWorkbook.Sheets("BOLETA PDF").Range("B5").Value = i
            Sheets("BOLETA PDF").Range("A1:J87").Copy
            Sheets("PDF").Range("A" & e - 86 & ":J" & e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next i

    End If
    
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & i & " Boletas" & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Sheets("PDF").Delete
End Sub

 

Edited by Gerson Pineda
Envolver en etiqueta

Share this post


Link to post
Share on other sites

Buenos días  @Luis paz, gracias por el aporte brindado, el cual se soluciono, la primera opción de no aparecer la carpeta para guardar los PDF, sin embargo cuando comienza a imprimir los PDF de 1 en 1, se genera 1 solo archivo, pero solo esta guardando el ultimo registro asignado con el numero 98, pero los primeros registros no se muestran.

Saludos y espero comentarios.

99 Boletas.pdf

Share this post


Link to post
Share on other sites
Hace 32 minutos , SALAVERRINO dijo:

Buenos días  @Luis paz, gracias por el aporte brindado, el cual se soluciono, la primera opción de no aparecer la carpeta para guardar los PDF, sin embargo cuando comienza a imprimir los PDF de 1 en 1, se genera 1 solo archivo, pero solo esta guardando el ultimo registro asignado con el numero 98, pero los primeros registros no se muestran.

Saludos y espero comentarios.

99 Boletas.pdf 74 kB · 0 descargas

Hola,

Se soluciona con lo siguiente:

Option Explicit
Dim i As Integer
Dim intInicial As Integer
Dim intFinal As Integer
Dim intConsecutivo As Integer
Dim srtTitulo As String
Dim Ruta As String
Dim e As Variant

Sub ElegirAccion2()


srtTitulo = "PRUEBITA"
intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value

    intInicial = Sheets("BOLETA PDF").Range("N4")
    intFinal = Sheets("BOLETA PDF").Range("M3")
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        Worksheets.Add.Name = "PDF"
        Sheets("BOLETA PDF").Select
        Ruta = ActiveWorkbook.Path
            
        e = 0
        For i = intInicial To intFinal
            e = e + 87
            ThisWorkbook.Sheets("BOLETA PDF").Range("B5").Value = i
            ThisWorkbook.Sheets("BOLETA PDF").Range("B5").Value = i
            Sheets("BOLETA PDF").Range("A1:J87").Copy
            Sheets("PDF").Range("A" & e - 86 & ":J" & e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next i

    End If

Sheets("PDF").Select

Sheets("PDF").PageSetup.PrintArea = "$A$1:$J$" & e
    
Sheets("PDF").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & i & " Boletas" & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Sheets("BOLETA PDF").Select

Sheets("PDF").Delete
End Sub

Existe un problema con el formato ya que no queda de la misma manera cuando imprimer uno por uno (con un formato específico y un área de impresión específica) a cuando imprimes todo...

Yo por lo pronto, solo puedo aportarte una idea, no la solución en sí.

Saludos amigo!

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png