VBA to print multiple sheets

[krodriguez]

Hello,

I have an excel file with hundreds of sheets, I need something that helps me simplify the print process of selecting each sheet that i need. All the sheets that I need to print are between sheet 10 and sheet 70, sheets are labeled e.i. sheet 10 reads USA, sheet 11 is Canada...sheet 70 Russia... any ideas?

Thanks

 

[DanteAmor]

You can use my app in the form to select sheets (updated) Download the file:
https://www.dropbox.com/s/8p05n2ui9...ro de Excel a imprimir o archivo v2.xlsm?dl=0


In column A put the name of sheets that should always be printed.
In column B put the sheets that should never be selected for printing, here you can use the "*" wildcard.
In column C put the range of number of sheets that will be selected.
Then press the button to open the userform, add or remove sheets from the previous selection and send to print to pdf or excel file.

In the file there are some examples

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

 

[Doug Mutzig]

Hi Dante,

Wow! Works great!!! Thank you!

Couple of other questions:
1. For column C I do not understand what I should put here (range of number of sheets?).
2. I have several buttons (both command and form) on my worksheets that get copied over. The issue is that they are still linked to the original workbook. Is there a way to not copy over the buttons, remove the buttons from the new workbook, or limit the range of what is copied over for each page?

I cannot thank you enough for all your help on this!!

 

[DanteAmor]

1. For column C I do not understand what I should put here (range of number of sheets?).

For example, if you have 100 sheets and you want to select from sheet 20 to sheet 50 then in cell C3 you put 20-50.
If you also want from sheet 55 to 60, then in C4 you put 55-60. When you open the form those sheets will be marked.

2. I have several buttons (both command and form) on my worksheets that get copied over.

Select the button, right click on the button, in properties check the option: "Dont move or size with cells"


Also uncheck the "Print object" option

Check the new version:
https://www.dropbox.com/s/o1ds2w93cucs6c5/Send%20multiple%20sheets%20to%20PDF-Print-File%20v3.xlsm?dl=0