Cambiar ruta de guardado al generar un archivo PDF de libro excel

Tengo una macro que me guarda las hojas del libro en formato PDF en la ubicacion del libro, quisiera saber la forma de que me de a elegir la ubicacion a guardar al generar el archivo PDF.

La macro es la siguiente :

Sub CommandButton1_Click()
'GUARDA LAS HOJAS COMPLETAS PREVIAMENTE SELECCIONADAS

Dim hoja As Control
x = 0
For Each hoja In Me.Controls
If Not hoja.Name = "CommandButton1" Then
x = x + 1
If hoja.Value = True Then
Worksheets(hoja.Caption).PageSetup.LeftFooter = hoja.Caption
If A = 1 Then ren = "False" Else ren = "True"
Worksheets(hoja.Caption).Select Replace:=ren
A = 1
End If
End If
Next
On Error Resume Next
'nbre = "Prueba " & Format(Date, "dd-mm-yyyy" & " " & Format(Time(), "hh-mm-ss")) '"Prueba1" O TAMBIÉN:
'nbre = InputBox("Escribe el nombre con el que quieres guardar:", "Guardar archivo") & " " & Format(Date, "dd-mm-yyyy" & " " & Format(Time(), "hh-mm-ss"))
nbre = Trim(InputBox(" Registre un Nombre ")) & Format(Date, "dd-mm-yyyy" & " " & Format(Time(), "hh-mm-ss"))
Set wb = ActiveWorkbook
With wb
RutaArchivo = ThisWorkbook.Path & "\" & nbre & ".pdf" '<==================================Ruta archivo
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=RutaArchivo, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'Sheets(1).Select
Unload Me
End With
End Sub

1

1 Respuesta

3.698.700 pts. Si me amas, siempre voy a estar en tu corazón; si me...

Te anexo la macro actualizada

Sub CommandButton1_Click()
'GUARDA LAS HOJAS COMPLETAS PREVIAMENTE SELECCIONADAS
    Dim hoja As Control
    x = 0
    For Each hoja In Me.Controls
        If Not hoja.Name = "CommandButton1" Then
            x = x + 1
            If hoja.Value = True Then
                Worksheets(hoja.Caption).PageSetup.LeftFooter = hoja.Caption
                If A = 1 Then ren = "False" Else ren = "True"
                Worksheets(hoja.Caption).Select Replace:=ren
                A = 1
            End If
        End If
    Next
    On Error Resume Next
    'nbre = "Prueba " & Format(Date, "dd-mm-yyyy" & " " & Format(Time(), "hh-mm-ss")) '"Prueba1" O TAMBIÉN:
    'nbre = InputBox("Escribe el nombre con el que quieres guardar:", "Guardar archivo") & " " & Format(Date, "dd-mm-yyyy" & " " & Format(Time(), "hh-mm-ss"))
    nbre = Trim(InputBox(" Registre un Nombre ")) & Format(Date, "dd-mm-yyyy" & " " & Format(Time(), "hh-mm-ss"))
    '
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1)
    End With
    '
    Set wb = ActiveWorkbook
    With wb
        RutaArchivo = cp & "\" & nbre & ".pdf" '<==================================Ruta archivo
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=RutaArchivo, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        'Sheets(1).Select
        Unload Me
    End With
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas