Extraer hojas de macro y guardar en binario
Tengo un libro con los 31 días del mes pero entre cada día hay dos hojas más que no utilizo, osea en excel sería así
Hoja R01 -> día 1
Hoja AC1 -> No la necesito en el nuevo archivo
Hoja AC2 -> Tampoco la necesito en el nuevo archivo
Hoja R02 -> día 2
Hoja AC2 -> No la necesito en el nuevo archivo
Hoja AS2 -> Tampoco la necesito en el nuevo archivo
Por que al cargar en el listbox todas las hojas del libro, el listado se vuelve muy extenso por que incluye también las hojas AC Y AS, entonces intente cargar item por item para solo cargar los días, las Hojas R01, R02 etc y así hacer más fácil la selección a la hora de seleccionar los días del mes que quiero generar, necesito que predeterminadamente a todos los archivos le cargue las hojas A, B Y DE por que son de listas desplegables y así que alimentan las hojas de los días (R01 Y R02 etc)
Luego el resultado final que necesito es un archivo guardado en formato binario en la misma ubicación del archivo original, que contenta los días seleccionados en el listbox + las hojas A, B y C, osea no necesito generar PDF ni imprimir nada, solo un archivo de excel con las hojas mencionadas anteriormente.
1 respuesta
Te anexo el código
En esta línea pon las hojas que siempre se han de enviar:
Hojas = Array("A", "B", "D")En esta otra línea pon las 2 primeras letras del nombre de las hojas que no quieres mostrar en el listbox:
Case "AC", "AS"
De esa forma las hojas que comiencen con AC o AS no las verás en el listbox.
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
'Guarda archivo nuevo en binario
ruta = ThisWorkbook.Path & "\"
arch = "varias hojas.xlsb"
Sheets(Pdfhojas).Copy
ActiveWorkbook.SaveAs _
Filename:=ruta & arch, _
FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close False
'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & arch & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If m > -1 Then
Sheets(HojasOcultas).Visible = 0
End If
End If
MsgBox "Archivo guardado", 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("A", "B", "D")
cargando = True
ListBox1.MultiSelect = 1
ListBox1.ListStyle = 1
For Each h In Sheets
Select Case Left(UCase(h.Name), 2)
Case "AC", "AS"
Case Else
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
End Select
Next
cargando = False
End Sub
.
. S aludos. Dante Amor. R ecuerda valorar la respuesta. G racias
.
