Guardar hoja como archivo pdf pero con el mismo nombre del archivo principal
B noches, tengo una macro que DAM me hizo para un archivo hace rato, pero ahora que la pruebo no me funciona y no he podido encontrar el error. La idea es que me guarde en pdf una hoja de un archivo pero que le ponga automáticamente el mismo nombre del archivo principal, cuando funcionaba me guardaba toda la página pero solo quiero una parte de ella que me guarde (A1:S38). Aquí dejo la macro y gracias:
Sub guarda()
'por.dam
ruta = ""
Set act = ThisWorkbook
uf = Range("T" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
Range("T2:U" & uf).Clear
Set nav = CreateObject("shell.application")
On Error Resume Next
car = nav.browseforfolder(0, _
"Selecciona la Carpeta en donde están los archivos", _
0, ruta).items.Item.Path
If car = "" Then Exit Sub
'On Error GoTo 0
ChDir car & "\"
Application.ScreenUpdating = False
Set nue = Workbooks.Add
archi = Dir("*.xl*")
j = 2
Do While archi <> ""
Workbooks.Open Filename:=archi
Set tst = ActiveWorkbook
Sheets("planilla").Copy After:=nue.Sheets(1)
werr = Err.Number
Err.Number = 0
If werr = 0 Then
msj = "Procesado"
Else
msj = "Archivo sin la hoja ''Planilla''"
End If
tst.Activate
tst.Close
act.Activate
Cells(j, "T") = archi
Cells(j, "U") = msj
j = j + 1
archi = Dir()
Loop
nue.Activate
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Guardar archivo como"
.AllowMultiSelect = False
.InitialFileName = ""
.FilterIndex = 25
If .Show Then
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=.SelectedItems(1), _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Application.DisplayAlerts = False
nue.Close
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
MsgBox "Archivo PDF generado"
ActiveWorkbook.Save
ActiveCell.Offset(6, 2).Range("A1").Select
ActiveWindow.SmallScroll Down:=-12
ActiveSheet.Shapes.Range(Array("1 Bisel")).Select
Application.Goto Reference:="'guarda con saveas (1).xlsm'!guarda"
ActiveWorkbook.Save
ActiveCell.Offset(31, 13).Range("A1").Select
ActiveSheet.Shapes.Range(Array("1 Bisel")).Select
Application.Goto Reference:="'guarda con saveas (1).xlsm'!guarda"
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Shapes.Range(Array("1 Bisel")).Select
End Sub
1 Respuesta
La macro hace lo siguiente:
- Solicita una carpeta
- Crea un libro nuevo
- Abre todos los archivos excel contenidos en la carpeta
- Copia la hoja "planilla" de cada archivo excel y la pega en el libro nuevo
- Y por último guarda el libro nuevo como PDF
¿Quieres qué siga haciendo lo mismo?
¿O solamente quieres guardar un rango como PDF?
Saludos. Dante Amor
Hola. Grx por tu pronta respuesta. Si quiero que me guarde un rango de la hoja como pdf. Grx
Pero entonces quieres una macro nueva, ¿qué solamente lea un archivo o el archivo ya lo tienes abierto?
Puedes explicarme con todo detalle lo que necesitas.
La vdd la macro si me funcionaba bn pero ahora no se que paso. Lo que quiero que haga es que me guarde en pdf un rango de la hoja "planilla" pero con el nombre original del archivo, por ejemplo, el archivo se llama "carlos1", quiero que la macro coja un rango de la hoja "planilla" de "carlos1", me lo convierta y grabe en pdf pero preguntando primero en donde, con esto me imagino:
car = nav.browseforfolder(0, _
"Selecciona la Carpeta en donde están los archivos", _
0, ruta).items.Item.Path
Esta macro lo que hacia creo es que cogía todos los archivos excel y cogía la hoja "planilla" y las grababa en pdf si se puede otra macro así, perfecto.
Gracias
Por eso te pregunto, ¿lo quieres para varios archivos o solamente uno?
La vdd me gustaría tener las dos opciones y si no pues para un archivo. Grx
Si lo quieres para varios archivos, ¿cómo quieres el funcionamiento?
Como los archivos de excel deben estar en una sola carpeta pues puede abrir el cuadro para buscar la carpeta con los archivos y luego pregunte donde guardar los pdf. Gtx
Me refiero a que si hay 10 archivos, y la macro abre los 10 archivos y de cada archivo va tomar el rango (A1:¿S38) en dónde se va a poner el rango de cada archivo?
Tomo el rango (A1:S38) del primer archivo y lo pongo en una hoja o lo exporto a PDF, ¿quieres un PDF o 10 PDF?
Ok. Uno por cada uno o sea 10 pdf. Grx
Hola Dante era para saber que ha pasado con la macro
grx
Te anexo la macro nueva para crear un pdf del rango A1:S38, por cada archivo que contenga la hoja "planilla".
Sub guarda()
'por.Dante Amor
Set h1 = ActiveSheet
uf = h1.Range("T" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
h1.Range("T2:U" & uf).Clear
'
Set nav = CreateObject("shell.application")
On Error Resume Next
car = nav.browseforfolder(0, "Selecciona la Carpeta ", 0, ruta).items.Item.Path
If car = "" Then Exit Sub
ChDir car & "\"
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
archi = Dir("*.xl*")
j = 2
Do While archi <> ""
Set l2 = Workbooks.Open(Filename:=archi)
l2.Sheets("planilla").Range("A1:S38").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=car & "\" & l2.Name & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err.Number = 0 Then
h1.Cells(j, "U") = "Procesado"
Else
h1.Cells(j, "U") = "Archivo sin la hoja ''Planilla''"
End If
Err.Number = 0
l2.Close
h1.Cells(j, "T") = archi
j = j + 1
archi = Dir()
Loop
MsgBox "Creación de PDF, Terminada"
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
Gracias por tu pronta respuesta. La macro funciona a la perfección y me sirve, pero fui yo el que me equivoque, lo que quiero es que al presionar el botón el haga lo mismo que hace esta macro pero que sea del archivo del cual estoy trabajando, es decir, si mi archivo se llama "carlos" y me encuentro trabajando en ese archivo, el me haga el pdf de la hoja llamada planilla con el nombre de "carlos", o sea, el mismo nombre. grx
Por eso te pregunte como 3 veces qué es lo que necesitabas. Al final me dijiste que se creara un pdf por cada archivo.
Puedes valorar esta respuesta y crear una nueva y me explicas con detalle lo que requieres.
Si que pena. Si es pdf pero del archivo que estoy trabajando con el mismo nombre
No te preocupes, con gusto te sigo ayudando, valora esta respuesta y crea una nueva por cada petición.
