Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » MACRO PARA GUARDAR PDF

Excel - MACRO PARA GUARDAR PDF

Volver
Nuevo Tema
<<>>
 
Vista:
Imágen de perfil de JOSE LUIS
Val: 80
Ha disminuido su posición en 3 puestos en Excel (en relación al último mes)
Gráfica de Excel

MACRO PARA GUARDAR PDF

Publicado por JOSE LUIS (60 intervenciones) el 12/01/2020 14:07:31
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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder