Generar pdf y guardar en carpetas distintas
Tengo una subrutina que me genera reportes en pdf, lo que pretendo hacer es que esos pdf me los guarde en carpetas con diferente nombre, osea las carpetas no siempre tienen el mismo formato, he intentado que me los guarde poniendo los datos de la carpeta en la ruta para guardar el archivo pero con eso solo consigo que me guarde unos cuantos y de hecho me he dado cuenta que solo genera un solo reporte al intentar eso, les daré un ejemplo:
Las carpetas tienen este formato
ID 15 SER 53 NUM 31
id 15 ser 52 NUM 30
id. 1372542 ser. 59 NUM 96
ID. 16 SER. 508 NUM 94
ID-152 SER. 57 NUM 25
id-147 ser. 50 NUM 25
SER 50 - ID 1 NUM 24
Yo tomo el valor serie numero e id de las celdas donde se genera mi reporte es decir el valor de id puede estar en cells 1,2 el de serie en cells 2,2 el de num en cells 4,9, también puse dos botones de selección ya que si es un numero de serie igual o mayor a 22 se ira a una ruta si es mayor a 33 se ira a otra y si es mayor a 7 se ira a otra, tal vez ahí es donde reside mi problema.
Ojala puedan a yudarme, esta es mi rutina:
Nombre= Range("A22").Value
c =Range("A27").Value
n = Range("B19").Value
s = Range("C19").Value
'On Error GoTo Errores
ruta = "C:\Genera\documents\" & "ID" & " " & c & " " & "SER" & " " & n & " " & "NUM" & " " & s & "\"
For i = 2 To Range("J" & Rows.Count).End(xlUp).Row
serie = Cells(i, "J")
If serie <> "" Then
[C17] = serie
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & Nombre & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Next
MsgBox "Fin"
1 Respuesta
H o l a:
Envíame un correo nuevo con tu archivo y con la macro. En el archivo me explicas con comentarios y con colores lo que necesitas.
Mi correo jov19p3@yahoo.com
En el asunto del correo escribe tu nombre de usuario “Jaime Esparza” y el título de esta pregunta.
Hola Sr. Dante.
Ya le he enviado mi archivo, espero su respuesta .
Saludos!.
Te anexo la macro
Sub GenerarPdfConOpcion()
'Por.Dante Amor
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path & "\"
If ActiveSheet.Caso1.Value = True Then
ruta = "D:\A\EXPEDIENTES ELECTRONICOS\ARRENDAMIENTO\"
'ruta = "C:\trabajo\expedientes\arrendamiento\"
ElseIf ActiveSheet.Caso2.Value = True Then
ruta = "D:\A\EXPEDIENTES ELECTRONICOS\LOCALES\"
'ruta = "C:\trabajo\expedientes\locales\"
End If
'
For i = 2 To Range("J" & Rows.Count).End(xlUp).Row
valor = Cells(i, "J")
If valor <> "" Then
[C17] = valor
idnum = Range("C17").Value
numer = Range("D14").Value
serie = Range("F19").Value
carpetas = Dir(ruta & "*", vbDirectory)
Do While carpetas <> ""
If carpetas <> "." And carpetas <> ".." And _
((GetAttr(ruta & carpetas) And vbDirectory) = 16) Then
If InStr(1, carpetas, idnum) > 0 And _
InStr(1, carpetas, numer) > 0 And _
InStr(1, carpetas, serie) > 0 Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & carpetas & "\" & idnum & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Exit Do
End If
End If
carpetas = Dir()
Loop
End If
Next
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
