Guardar determinadas hojas de Excel en PDF solicitando la Ruta y nombre

Tengo un libro de Excel sumamente grande y quiero guardarlo en PDF.

Pero necesito poder elegir que hojas quiero guardar y cuales no, hay unas hojas que siempre se deberán guardar.

Pensaba crear un botón que me despliegue el "menú de hojas" para poder elegirlas y las hojas que siempre deben estar presentes, no aparezcan en el menú, pero que se guarden en el PDF automáticamente.

Espero ser claro en lo que necesito y agradezco de antemano tu ayuda.

1 Respuesta

Respuesta
2

Deberás crear un userform, sigue los pasos indicados en el siguiente enlace:

MACRO de excel para imprimir varias hojas de un mismo libro


Cambia en esta línea, los nombres de las hojas que siempre quieres que se impriman, te aparecerán en el list como seleccionadas y no podrás desmarcarlas.

Hojas = Array("Print_page", "Hoja2", "index", "revision")

En el userform pon esta macro

Dim hojas
Dim cargando
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
    Dim Pdfhojas()
    Dim HojasOcultas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = ThisWorkbook.Path & "\"
    arch = "varias"
    n = -1
    m = -1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            h = ListBox1.List(i)
            n = n + 1
            ReDim Preserve Pdfhojas(n)
            Pdfhojas(n) = h
            wvis = Sheets(h).Visible
            If wvis <> -1 Then
                m = m + 1
                ReDim Preserve HojasOcultas(m)
                HojasOcultas(m) = h
                Sheets(h).Visible = -1
            End If
            Sheets(h).PrintOut Copies:=1, Collate:=True
            'Sheets(h).Visible = wvis
        End If
    Next
    If n > -1 Then
        Sheets(Pdfhojas).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ruta & arch & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        Sheets(HojasOcultas).Visible = 0
    End If
    MsgBox "Impresión terminada", vbInformation
End Sub
'
Private Sub ListBox1_Change()
'Por.Dante Amor
    If cargando Then Exit Sub
    cargando = True
    For i = 0 To ListBox1.ListCount - 1
        For j = LBound(hojas) To UBound(hojas)
            If LCase(ListBox1.List(i)) = LCase(hojas(j)) Then
                ListBox1.Selected(i) = True
                Exit For
            End If
        Next
    Next
    cargando = False
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
    hojas = Array("Print_page", "Hoja2", "index", "revision")
    cargando = True
    ListBox1.MultiSelect = 1
    ListBox1.ListStyle = 1
    For Each h In Sheets
        ListBox1.AddItem h.Name
        For j = LBound(hojas) To UBound(hojas)
            If LCase(h.Name) = LCase(hojas(j)) Then
                ListBox1.Selected(ListBox1.ListCount - 1) = True
                Exit For
            End If
        Next
    Next
    cargando = False
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Gracias por tu pronta respuesta.

Me arroja un error, #13

le doy depurar y me selecciona esta línea : For j = LBound(hojas) To UBound(hojas)

¿Copiaste la macro completa?

Revisa que hayas copiado todo el código.

El código empieza desde la línea Dim hojas:

Dim hojas
Dim cargando
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
    Dim Pdfhojas()
    Dim HojasOcultas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = ThisWorkbook.Path & "\"
    arch = "varias"
    n = -1
    m = -1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            h = ListBox1.List(i)
            n = n + 1
            ReDim Preserve Pdfhojas(n)
            Pdfhojas(n) = h
            wvis = Sheets(h).Visible
            If wvis <> -1 Then
                m = m + 1
                ReDim Preserve HojasOcultas(m)
                HojasOcultas(m) = h
                Sheets(h).Visible = -1
            End If
            Sheets(h).PrintOut Copies:=1, Collate:=True
            'Sheets(h).Visible = wvis
        End If
    Next
    If n > -1 Then
        Sheets(Pdfhojas).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ruta & arch & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        Sheets(HojasOcultas).Visible = 0
    End If
    MsgBox "Impresión terminada", vbInformation
End Sub
'
Private Sub ListBox1_Change()
'Por.Dante Amor
    If cargando Then Exit Sub
    cargando = True
    For i = 0 To ListBox1.ListCount - 1
        For j = LBound(hojas) To UBound(hojas)
            If LCase(ListBox1.List(i)) = LCase(hojas(j)) Then
                ListBox1.Selected(i) = True
                Exit For
            End If
        Next
    Next
    cargando = False
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
    hojas = Array("Print_page", "Hoja2", "index", "revision")
    cargando = True
    ListBox1.MultiSelect = 1
    ListBox1.ListStyle = 1
    For Each h In Sheets
        ListBox1.AddItem h.Name
        For j = LBound(hojas) To UBound(hojas)
            If LCase(h.Name) = LCase(hojas(j)) Then
                ListBox1.Selected(ListBox1.ListCount - 1) = True
                Exit For
            End If
        Next
    Next
    cargando = False
End Sub

Si continúa el problema, dime exactamente qué le cambiaste a la macro, todo el mensaje de error te aparece y en cuál sección de la macro se detiene.

Si te funciona, r ecuerda cambiar la valoración de la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas