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.
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 SubSi 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.
