Excel - GUARDAR EN PDF

   
Vista:

GUARDAR EN PDF

Publicado por CLAUDIO cfernandogatica@gmail.com (7 intervenciones) el 21/07/2017 17:11:52
HOLA COMUNIDAD
mi pregunta es la siguiente, tengo el codigo de una macro en el cual me convierte a pdf una hoja en excel en la cual tengo comprobantes de pago o liquidaciones de sueldo, etc, me refiero a que me separa por rango y por nombre y los convierte a pdf segun el nombre de una celda (esval 1, esval 2, esval 3..,etc) la macro esta casi completa, lo unico que falta es que si el nombre se repite 2 veces me aparezcan 2 comprobantes de pago o liquidaciones en solo un PDF, asi sean 30, 100, o 1000 liquidaciones (pero con el mismo nombre, o sea que todos los "esval 1" sean en un solo PDF) en solo 1 PDF, luego otro nombre en otro PDF (independiente cuantos comprobantes de pagos sean) etc.
muchas gracias.
adjunto macro y archivo excel de ejemplo.
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

GUARDAR EN PDF

Publicado por CLAUDIO (7 intervenciones) el 24/07/2017 23:42:49
nadie responde
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

GUARDAR EN PDF

Publicado por Antoni Masana (404 intervenciones) el 27/07/2017 13:06:42
Para poder hacer lo que quieres debes ordenar.

Primero cuantas cuantos códigos hay es y la cantidad de documentos por ejemplo y de paso guardas la linea de inicio de cada uno

esval 1 (3)
esval 2 (1)
esbal 3 (2)

En segundo lugar los copias por orden es decir

esval 1 (1)
esval 1 (2)
esval 1 (3)
esval 2 (1)
esval 3 (1)
esval 3 (2)

Pones saltos de pagina entre documentos

Y ahora tomas el primer código (esval 1) selecciona desde A1 hasta H216 (+ o - ) e imprimes
Ahora tomas el segundo código (esval 2) selecciona desde A217 hasta H288 (+ o - ) e imprimes
Ahora tomas el tercer código (esval 3) selecciona desde A289 hasta H432 (+ o - ) e imprimes

NOTA : He calculado 72 líneas por documento para el ejemplo pero tu debes hacer tus cálculos.

Si no me he explicado bien dime y volveré a intentarlo lago mejor.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

GUARDAR EN PDF

Publicado por CLAUDIO (7 intervenciones) el 28/07/2017 19:56:26
hola amigo gracias por responder, la verdad no entendi mucho la respuesta, preferiria trabajar con esta macro que esta 99% lista:


1
2
3
4
5
6
7
8
9
10
11
12
Sub PDFS()
Dim ruta As String, nombre As String  'Definición tipos de variables
ruta = ThisWorkbook.Path & "\"         'Obtiene la ruta del archivo
Application.ScreenUpdating = False   'Evita centelleo de pantalla
Do While [G9] <> ""     'Hacerlo mientras celda G9 sea distinto de blanco
nombre = [G9].Value    'Obtiene el nombre de celda G9
[A1:H70].ExportAsFixedFormat Type:=0, Filename:= _
ruta & nombre, IncludeDocProperties:=1, OpenAfterPublish:=0  'El rango A9:H70 lo guarda como PDF
[A1:H70].EntireRow.Delete   'Elimina el rango A9:H78.
Loop                                'Repite el bucle
Application.ScreenUpdating = True
End Sub

pero lo unico que me falta es que si dos planillas tienen el mismo codigo, las dos me las guarde en un solo pdf y la macro guarda solo una planilla, es algo muy pequeño que me falta.

ojala me puedas ayudar, si quiere puede ejecutar este codigo y se dara cuenta con la planilla (al principio que se llamam "villa alemana") y son 2 planillas, pero me guarda una.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

GUARDAR EN PDF

Publicado por Antoni Masana (404 intervenciones) el 29/07/2017 01:09:46
En tu primer POST vi la macro y lo que hace. Te voy a decir que para empezar esta MAL para hacerlo como lo que quieres.

Se puede hacer de dos formas como mínimo que yo conozca:

1.- Exportar.
2.- Imprimiendo en PDF

Y para las dos debes hacer lo mismo. Si entendí bien la lo que deseas hacer es grabar en PDF dos o mas plantillas con el mismo codigo y entiendo por código el contenido de la celda G9 que es el Centro de Costo.

En este ultimo ejemplo me va muy bien para explicar lo que explique en el POST anterior con un ejemplo:

En la hoja hay estos Centros Costo y en este orden

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
Centro Costo:		ESVAL - OF. COMERCIAL VILLA ALEMANA
Centro Costo:		ESVAL - OF. COMERCIAL VILLA ALEMANA
Centro Costo:		ESVAL - OF. QUINTEROS
Centro Costo:		ESVAL - OF. COMERCIAL VIÑA DEL MAR
Centro Costo:		ESVAL - OFICINA SAN FELIPE
Centro Costo:		ESVAL - PLANTA GOENECHEA LA LIGUA
Centro Costo:		ESVAL - OF. COMERCIAL VIÑA DEL MAR
Centro Costo:		ESVAL - PLANTA SAN JUAN - SAN ANTONIO
Centro Costo:		ESVAL - OFICINA SAN FELIPE
Centro Costo:		ESVAL - OFICINA ZAPALLAR
Centro Costo:		ESVAL - OF. CASABLANCA
Centro Costo:		ESVAL - OF. COMERCIAL VIÑA DEL MAR
Centro Costo:		ESVAL - RECINTO EL CRISTO QUILLOTA
Centro Costo:		ESVAL - OFICINA PUTAENDO
Centro Costo:		ESVAL - OFICINA QUILLOTA
Centro Costo:		ESVAL - OFICINA LIMACHE
Centro Costo:		ESVAL - RECINTO SAN GUILLERMO VALPARAISO
Centro Costo:		ESVAL - SUPERVISION V REGION
Centro Costo:		ESVAL - OFICINA CALLE LARGA
Centro Costo:		ESVAL - OFICINA LA CALERA
Centro Costo:		ESVAL - OF. COMERCIAL QUILPUE
Centro Costo:		ESVAL - OFICINA SAN FELIPE
Centro Costo:		ESVAL - PLANTA A.P. CONCON
Centro Costo:		ESVAL - EDIFICIO ZONAL SAN ANTONIO
Centro Costo:		ESVAL - OFICINA CARTAGENA
Centro Costo:		ESVAL - OF. COMERCIAL CONCON
Centro Costo:		ESVAL - OFICINA QUILLOTA
Centro Costo:		ESVAL - OFICINA QUILLOTA
Centro Costo:		ESVAL - RECINTO TOMAS RAMOS VALPARAISO
Centro Costo:		ESVAL - EDIFICIO ZONAL SAN ANTONIO
Centro Costo:		ESVAL - PAP CASABLANCA
Centro Costo:		ESVAL - OF. COMERCIAL VIÑA DEL MAR
Centro Costo:		ESVAL - OF. QUINTEROS
Centro Costo:		ESVAL - RECINTO SAN GUILLERMO VALPARAISO
Centro Costo:		ESVAL - OFICINA CARTAGENA
Centro Costo:		ESVAL - OFICINA ALGARROBO
Centro Costo:		ESVAL - RECINTO ESPERANZA QUILPUE
Centro Costo:		ESVAL - OFICINA LLAY LLAY
Centro Costo:		ESVAL - OFICINA PETORCA
Centro Costo:		ESVAL - PLANTA CORDILLERA LOS ANDES
Centro Costo:		ESVAL - OF. COMERCIAL VIÑA DEL MAR
Centro Costo:		ESVAL - OFICINA CABILDO
Centro Costo:		ESVAL - OF. COMERCIAL VIÑA DEL MAR

Y tu quieres que por ejemplo el Centro Costo "ESVAL - EDIFICIO ZONAL SAN ANTONIO" que hay 2 estén en el mismo PDF y no están juntos.

La idea es esta: Recorres la columna E y cuando en la celda encuentres el texto “Centro Costo:” guardas lo que hay en la columna G y la fila, esto lo puedes ir haciendo en un hoja temporal cuando finalices de recorrer la tabla tienes que ordenarla y tiene que quedar algo asi:

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
ESVAL - EDIFICIO ZONAL SAN ANTONIO         1619
ESVAL - EDIFICIO ZONAL SAN ANTONIO         2039
ESVAL - OF. CASABLANCA                      709
ESVAL - OF. COMERCIAL CONCON               1759
ESVAL - OF. COMERCIAL QUILPUE              1409
ESVAL - OF. COMERCIAL VILLA ALEMANA           9
ESVAL - OF. COMERCIAL VILLA ALEMANA          79
ESVAL - OF. COMERCIAL VIÑA DEL MAR          219
ESVAL - OF. COMERCIAL VIÑA DEL MAR          429
ESVAL - OF. COMERCIAL VIÑA DEL MAR          779
ESVAL - OF. COMERCIAL VIÑA DEL MAR         2179
ESVAL - OF. COMERCIAL VIÑA DEL MAR         2809
ESVAL - OF. COMERCIAL VIÑA DEL MAR         2949
ESVAL - OF. QUINTEROS                       149
ESVAL - OF. QUINTEROS                      2249
ESVAL - OFICINA ALGARROBO                  2459
ESVAL - OFICINA CABILDO                    2879
ESVAL - OFICINA CALLE LARGA                1269
ESVAL - OFICINA CARTAGENA                  1689
ESVAL - OFICINA CARTAGENA                  2389
ESVAL - OFICINA LA CALERA                  1339
ESVAL - OFICINA LIMACHE                    1059
ESVAL - OFICINA LLAY LLAY                  2599
ESVAL - OFICINA PETORCA                    2669
ESVAL - OFICINA PUTAENDO                    919
ESVAL - OFICINA QUILLOTA                    989
ESVAL - OFICINA QUILLOTA                   1829
ESVAL - OFICINA QUILLOTA                   1899
ESVAL - OFICINA SAN FELIPE                  289
ESVAL - OFICINA SAN FELIPE                  569
ESVAL - OFICINA SAN FELIPE                 1479
ESVAL - OFICINA ZAPALLAR                    639
ESVAL - PAP CASABLANCA                     2109
ESVAL - PLANTA A.P. CONCON                 1549
ESVAL - PLANTA CORDILLERA LOS ANDES        2739
ESVAL - PLANTA GOENECHEA LA LIGUA           359
ESVAL - PLANTA SAN JUAN - SAN ANTONIO       499
ESVAL - RECINTO EL CRISTO QUILLOTA          849
ESVAL - RECINTO ESPERANZA QUILPUE          2529
ESVAL - RECINTO SAN GUILLERMO VALPARAISO   1129
ESVAL - RECINTO SAN GUILLERMO VALPARAISO   2319
ESVAL - RECINTO TOMAS RAMOS VALPARAISO     1969
ESVAL - SUPERVISION V REGION               1199

Un truco para crear esta tabla, la primera línea del Centro Costo es la 9 y para las siguiente sumas 70, pues el código sería algo así

1
2
3
4
5
Lin = 9
While Cells(Lin, 7) <> “”
    ` --- aquí es donde guardas Cells(Lin, 7) y Lin
    Lin = Lin + 70
Wend

Ahora tomamos el primero:

1
2
ESVAL - EDIFICIO ZONAL SAN ANTONIO	1619
ESVAL - EDIFICIO ZONAL SAN ANTONIO	2039

Y en una variable de texto tienes que montar lo siguiente:

1
2
3
4
5
6
7
8
Texto = “A1619:H1680,A2039:H2100”
    Range(Texto).Select
--- Y aquí grabas
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=Ruta & Centro, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _

Y ahora la pregunta como monto todo esto para que funcione

Te voy a poner todo el código

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Sub Mis_PDFs()
    Dim Temp As String, Linea As Single, Desti As Single
    Dim Ruta As String, Centro As String, Rango As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Ruta = ThisWorkbook.Path & "\"
 
    Sheets.Add After:=ActiveSheet    ' -- creo una hoja
 
    Temp = ActiveSheet.Name         ' -- Busco el nombre
 
    Sheets("Hoja1").Select          ' -– Selecciona la hoja de plantillas
 
    Linea = 9
    Desti = 1
 
    While Cells(Linea, 7) <> ""
        Sheets(Temp).Cells(Desti, 1) = Cells(Linea, 7) ' --- Centro
        Sheets(Temp).Cells(Desti, 2) = Linea           ' --- Linea
        Linea = Linea + 70
        Desti = Desti + 1
        DoEvents
    Wend
 
    ' ---&--- Ahora ordeno la tabla de la hoja que he creado
 
    Sheets(Temp).Select
    Columns("A:B").Select
 
    ActiveWorkbook.Worksheets(Temp).Sort.SortFields.Clear
 
    ActiveWorkbook.Worksheets(Temp).Sort.SortFields.Add _
                                    Key:=Range("A:A"), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    DataOption:=xlSortNormal
 
    ActiveWorkbook.Worksheets(Temp).Sort.SortFields.Add _
                                    Key:=Range("B:B"), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    DataOption:=xlSortNormal
 
    With ActiveWorkbook.Worksheets(Temp).Sort
        .SetRange Range("A:B")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
 
    ' ---&--- Ahora creamos PDF
 
    ' --- Tomo los datos del primero
 
    Centro = Cells(1, 1)
    Rango = "A" & Cells(1, 2) & ":B" & Cells(1, 2) + 61
    Linea = 2
 
    While Cells(Linea, 1) <> ""
       If Centro = Cells(Linea, 1) Then
          Rango = Rango & ",A" & Cells(Linea, 2) & ":B" & Cells(Linea, 2) + 61
       Else
          Call Crea_PDF(Ruta, Centro, Rango, Temp)
          Centro = Cells(Linea, 1)
          Rango = "A" & Cells(Linea, 2) & ":B" & Cells(Linea, 2) + 61
       End If
       Linea = Linea + 1: DoEvents
    Wend
 
    ' ---&---  Imprimo el ultimo
 
    Call Crea_PDF(Ruta, Centro, Rango, Temp)
 
    ' ---&---  Borro la hoja temporal
 
    Sheets(Temp).Delete
    Sheets("Hoja1").Select
    Range("A1").Select
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    MsgBox "Macro finalizara", vbInformation + vbOKOnly, "Crear PDF"
End Sub
 
' ---&---  Crea el PDF
 
Sub Crea_PDF(Ruta, Centro, Rango, Temp)
    Sheets("Hoja1").Select
    Range(Rango).Select
 
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
                                  Filename:=Ruta & Centro, _
                                  Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, _
                                  IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=False
    Sheets(Temp).Select
End Sub

Y esto es todo.

Te aconsejo que analices el código y si no entiendes algo me lo preguntes

Saludos.
\\//_

P.D.. Te adjunto el Excel con la MACRO ya probara.y este texto en un documento Word. Mira porque soy así chulo.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar

GUARDAR EN PDF

Publicado por CLAUDIO (7 intervenciones) el 31/07/2017 15:59:58
Don Antoni:

se paso, bravo, bravo, es usted un seco, nadie hubiera hecho lo que usted,se dio el tiempo de resolver esta problematica y me entendio a la perfeccion mi idea, es lo que necesitaba, no sabe cuanto me ha ayudado, no se como agradecerle el trabajo efectuado, estos son los momentos cuando digo que dios existe, gracias de verdad buen hombre.

para terminar esta cuestion tengo por ultimo los siguientes detalles:

- el sistema en el cual trabajo que es softland, en este mismo formato me emite estas planillas que son muchas, ¿este codigo lo puedo usar en ellas tambien? claro que con otros centros de costos etc, pero me las arroja con los mismo tamaños y formatos etc.

- cuando las convierte a pdf, salen excelentes pero me toma de la linea 9 y yo quiero de la linea 1, cual arrelgo, me podria ayudar con eso porfis por fis!!!!!

- y al costado derecho de cada hoja o planilla, viene un logo de la empresa a la que trabajo y tambien quiero que aparezca, pero en el codigo anterior que le envie, ese que estaba al 99%, como que sobreponia un codigo sobre el otro, era extraño, jajajaja, bueno para alguien como yo jejeje.

Don Antonio, de verdad se lo agradezco mucho, ya que llevo mucho tiempo dando con este codigo, esta idea para suprimir mi trabajo, en la cual recibi muchos rechazos en otros portales de visual basic o macros excel, pero esto es fantastico.
es un profesional y merece mis respetos!!!!
gracias!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

GUARDAR EN PDF

Publicado por Antoni Masana (404 intervenciones) el 31/07/2017 19:48:59
Repongo a las preguntas

1.- Si, con los ajustes adecuados si hay diferencias en base a la estructura.

2.- En el Numero que sigue a la A hay que restar 8, hay tres líneas que debes modificar y por la numeración del Post anterior son 61, 66 y 70. Pongo de ejemplo la primera:

Sin Cabecera

1
Rango = "A" & Cells(1, 2) & ":B" & Cells(1, 2) + 61

Con Cabecera

1
Rango = "A" & Cells(1, 2) - 8 & ":B" & Cells(1, 2) + 61

3.- Cuando hagas la corrección de la pregunta anterior tendrás el LOGO impreso (probado).

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
2
Comentar

GUARDAR EN PDF

Publicado por CLAUDIO (7 intervenciones) el 31/07/2017 21:19:46
don antony:

estoy que lloro de la emocion, gracias, salio perfecto, era lo que queria hacer, no se como agradecer, el mejor de todos, se lucio, de todo corazon le agradezco, esta herramienta de trabajo me facilitara mucho mis labores diarias, gracias a los adm del foro que creo que la verdadera intencion es ayudar al que lo necesita en este mundo de la programacion, es una labor fantastica la que ejecutan y se lucen de verdad, los mas capos se lucen.

don Antony le estare eternamente agradecido por la atencion y el tiempo que dedico en estos jeroglificos computacionales que solo los mas aptos pueden responder, se que hable con un profesional, a usted deberian contratarlo en Softland y ya no habrian tantas falencias en los sistemas.

gracias, se paso.!!!!!!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

GUARDAR EN PDF

Publicado por CLAUDIO (7 intervenciones) el 03/08/2017 19:58:03
DON ANTONY:

como esta, a ver si me puede ayudar, por que con una planilla funciona (850) y con la otra no (805).
o sea me funcionaron la mayoria de las areas de negocios, pero la 805 no paso nada, digame que tendria que hacer en la planilla 805 para que funcione, por que el codigo esta perfecto, asi que para los proximos meses esa misma area de negocio salga con formato similiar y tenga que solo arreglarle el defecto a la planilla que me indicara usted si es que tiene alguno.

muchas gracias, disculpe las molestias.
adjunto archivos.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

GUARDAR EN PDF

Publicado por CLAUDIO cfernandogatica@gmail.com (7 intervenciones) el 07/08/2017 16:12:25
bueno don Antony me hize pedazos el craneo tratando de dar con el error, es que recien me integro a este mundo tan fascinante, pero no pude hallarlo, si no recibi respuesta de parte suya es quizas considera que culmino con esta problematica y eso se entiende, reitero mis agradecimientos por la gestion recibida de vuestra parte.

saludos.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

GUARDAR EN PDF

Publicado por Antoni Masana (404 intervenciones) el 07/08/2017 20:40:21
No lo he visto hasta ahora.
Déjame que le de un Vistazo.

Saludo.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

GUARDAR EN PDF

Publicado por Antoni Masana (404 intervenciones) el 07/08/2017 21:51:41
Ya vi que pasa.

En el libro 850 funciona bien y crea el PDF, en este caso 1 PDF

El 805 no funciona porque hay muchos rangos (Exactamente 27 segmentos) y el Excel debe tener algún limite en el numero segmentos del rango a la hora de seleccionar.

Abra que hacer algún cambio.

Mañana lo miro de resolver, ahora es tarde y me tengo que ir a dormir.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

GUARDAR EN PDF

Publicado por Antoni Masana (404 intervenciones) el 08/08/2017 08:49:48
Ya esta arreglado. He tenido que cambiar la forma de hacerlo. En lugar de seleccionar los diferentes documentos, que a veces no funciona y otras si los copio en otra hoja manteniendo el formato de la Hoja1

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
Option Explicit
 
' </> ------------------------------------------------------------------- </>
' </> ---&--- </>                                             </> ---&--- </>
' </> ---&--- </>   C o n v i e r t e   a   P D F             </> ---&--- </>
' </> ---&--- </>                                             </> ---&--- </>
' </> ------------------------------------------------------------------- </>
 
Sub Mis_PDFs()
    Dim Temp As String, Linea As Single, Desti As Single, _
        Work As String
    Dim Ruta As String, Centro As String, Rango As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
 
    Ruta = ThisWorkbook.Path & "\"
 
    ' ---&--- Hoja para crear el indice
 
 
    Sheets.Add After:=ActiveSheet    ' -- creo una hoja
    Temp = ActiveSheet.Name         ' -- Busco el nombre
    Columns("A:A").ColumnWidth = 45
 
    ' ---&--- Hoja para Imprimir
 
    Sheets("Hoja1").Select
    Sheets("Hoja1").Copy After:=Sheets(Sheets.Count)
 
    Work = ActiveSheet.Name
 
    Sheets(Work).Select
    Cells.Select
    Selection.ClearComments
    Selection.ClearContents
 
    ' ---&--- Selecciona la hoja de plantillas
 
    Sheets("Hoja1").Select
 
    Linea = 9
    Desti = 1
 
    While Cells(Linea, 7) <> ""
        Sheets(Temp).Cells(Desti, 1) = Cells(Linea, 7) ' --- Centro
        Sheets(Temp).Cells(Desti, 2) = Linea           ' --- Linea
        Linea = Linea + 70
        Desti = Desti + 1
        DoEvents
    Wend
 
    ' ---&--- Ahora ordeno la tabla de la hoja que he creado
 
    Sheets(Temp).Select
    Columns("A:B").Select
 
    ActiveWorkbook.Worksheets(Temp).Sort.SortFields.Clear
 
    ActiveWorkbook.Worksheets(Temp).Sort.SortFields.Add _
                                    Key:=Range("A:A"), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    DataOption:=xlSortNormal
 
    ActiveWorkbook.Worksheets(Temp).Sort.SortFields.Add _
                                    Key:=Range("B:B"), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    DataOption:=xlSortNormal
 
    With ActiveWorkbook.Worksheets(Temp).Sort
        .SetRange Range("A:B")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
 
    ' ---&--- Ahora creamos PDF
 
    ' --- Tomo los datos del primero de la hoja1 y lo copia a la Hoja Work
 
    Centro = Cells(1, 1)
    Desti = 1
    Rango = "A" & Cells(1, 2) - 8 & ":H" & Cells(1, 2) + 61
 
    Sheets("Hoja1").Range(Rango).Copy Sheets(Work).Range("A" & Desti)
 
    Linea = 2
    Desti = Desti + 70
 
    Sheets(Work).Select
        Range("I" & Desti).Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
        ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=ActiveCell
    Sheets(Temp).Select
 
 
    While Cells(Linea, 1) <> ""
       If Centro = Cells(Linea, 1) Then
          Rango = "A" & Cells(Linea, 2) - 8 & ":H" & Cells(Linea, 2) + 61
          Sheets("Hoja1").Range(Rango).Copy Sheets(Work).Range("A" & Desti)
 
          Desti = Desti + 70
          Sheets(Work).Select
              Range("I" & Desti).Select
              ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
              ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=ActiveCell
          Sheets(Temp).Select
       Else
          Rango = "A1:H" & Desti - 1
          Call Crea_PDF(Ruta, Centro, Rango, Temp, Work)
 
          Centro = Cells(Linea, 1)
 
          Desti = 1
          Rango = "A" & Cells(Linea, 2) - 8 & ":H" & Cells(Linea, 2) + 61
          Sheets("Hoja1").Range(Rango).Copy Sheets(Work).Range("A" & Desti)
 
          Desti = Desti + 70
          Sheets(Work).Select
              Range("I" & Desti).Select
              ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
              ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=ActiveCell
          Sheets(Temp).Select
       End If
       Linea = Linea + 1: DoEvents
    Wend
 
    ' ---&---  Imprimo el ultimo
 
    Rango = "A1:H" & Desti - 1
    Call Crea_PDF(Ruta, Centro, Rango, Temp, Work)
 
    ' ---&---  Borro la hoja temporal
 
    Sheets(Temp).Delete
    Sheets(Work).Delete
 
    Sheets("Hoja1").Select
    Range("A1").Select
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    MsgBox "Macro finalizara", vbInformation + vbOKOnly, "Crear PDF"
End Sub
 
' </> --------------------------------------------------------------------- </>
' </> ---&--- </>                                                   ---&--- </>
' </> ---&--- </>   Crea el PDF                                     ---&--- </>
' </> ---&--- </>                                                   ---&--- </>
' </> --------------------------------------------------------------------- </>
 
Sub Crea_PDF(Ruta, Centro, Rango, Temp, Work)
    Sheets(Work).Select
    Range(Rango).Select
 
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
                                  Filename:=Ruta & Centro, _
                                  Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, _
                                  IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=False
    Sheets(Temp).Select
End Sub
 
' </> ------------------------------------------------------------------- </>
' </> ---&--- </>                                             </> ---&--- </>
' </> ---&--- </>   F I N   M A C R O S                       </> ---&--- </>
' </> ---&--- </>                                             </> ---&--- </>
' </> ------------------------------------------------------------------- </>

De momento funciona en el 805

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar