Dim rhojas
Dim cargando
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
Dim Pdfhojas()
Dim HojasOcultas()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
hojaactiva = ActiveSheet.Name
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
End If
Next
If n > -1 Then
ruta = ThisWorkbook.Path & "\"
arch = "varias hojas"
'
'Guarda archivo PDF
If CheckBox1.Value = True Then
Sheets(Pdfhojas).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & arch & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
'
'Imprime las hojas
If CheckBox2.Value = True Then
Sheets(Pdfhojas).PrintOut
End If
'
'Guarda archivo como xlsx
If CheckBox3.Value = True Then
Sheets(hojas).Copy
ActiveWorkbook.SaveAs _
Filename:=ruta & arch & ".xlsx", _
FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close False
End If
'
'Guarda archivo como Binario
'Sheets(hojas).Copy
'ActiveWorkbook.SaveAs _
Filename:=ruta & arch, _
FileFormat:=xlExcel12, CreateBackup:=False
'ActiveWorkbook.Close False
'
'Oculta nuevamente las hojas
If m > -1 Then
Sheets(HojasOcultas).Visible = 0
End If
End If
Sheets(hojaactiva).Select
MsgBox "Finish", 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 Each j In rhojas
If LCase(ListBox1.List(i)) = LCase(j.Value) Then
ListBox1.Selected(i) = True
Exit For
End If
Next
Next
cargando = False
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
Set rhojas = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set rnever = Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)
uc = Range("C" & Rows.Count).End(xlUp).Row
If uc > 2 Then Set rrango = Range("C3:C" & uc)
'
cargando = True
ListBox1.MultiSelect = 1
ListBox1.ListStyle = 1
For Each h In Sheets
'sheets never select
existe = False
For Each j In rnever
If LCase(h.Name) Like LCase(j.Value) Then
existe = True
Exit For
End If
Next
If existe = False Then
ListBox1.AddItem h.Name
End If
'
'sheets always select
For Each j In rhojas
If LCase(h.Name) = LCase(j.Value) Then
ListBox1.Selected(ListBox1.ListCount - 1) = True
Exit For
End If
Next
'
'sheets select
If uc > 2 Then
For Each j In rrango
xnum = Split(j.Value, "-")
ini = Val(xnum(0))
fin = Val(xnum(UBound(xnum)))
For k = ini To fin
If h.Index = k Then
ListBox1.Selected(ListBox1.ListCount - 1) = True
Exit For
End If
Next
Next
End If
Next
cargando = False
End Sub