Userform with Multiselection Listbox for one print job

paradadf

New Member
Joined
Dec 4, 2018
Messages
4
Dear all, I've been trying to create an UserForm for printing from a dinamically generated ListBox of available Sheets on my workbook. It looks like this:

8MgzQ.jpg


I set 1 - fmMultiSelectMulti in the ListBox properties to allow multiselection. Usually, I need the sheets printed in color, as well as a copy printed in black and white. And to be sure everything looks good before spending some ink, there is a checkbox for the print preview.
So far, I've managed to capture the selection and store it in a variable called SheetsToPrint. But the print command below is failing with Subscript out of range (Error 9).
Code:
[COLOR=#303336][FONT=inherit]Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Array[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]SheetsToPrint[/FONT][/COLOR][COLOR=#303336][FONT=inherit])).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]PrintOut preview[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]True[/FONT][/COLOR]
Note: Using only Worksheets(SheetsToPrint) doesn't work either

If I don't use the variable and change it to the following string, it works as expected:
Code:
[COLOR=#303336][FONT=inherit]Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Array[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Sheet1"[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Sheet2"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]PrintOut preview[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]True[/FONT][/COLOR]

And I get what I need in a single print job. Except for the basketball image not being shown/printed properly :S.


Code:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">[COLOR=#101094][FONT=inherit]Private [FONT=inherit]Sub[/FONT][COLOR=#303336][FONT=inherit] UserForm_Initialize[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR]
[/FONT][/COLOR]Dim N As Integer
    Do
    N = N + 1
    If Sheets(N).Visible = True Then
        SelectedSheets.AddItem Sheets(N).Name
    End If
    Loop Until N = Worksheets.Count
End Sub
Private Sub SelectAll_Click()
    Dim N As Single
    If SelectAll.Value = True Then
        For N = 0 To SelectedSheets.ListCount - 1
        SelectedSheets.Selected(N) = True
        Next N
    Else
        For N = 0 To SelectedSheets.ListCount - 1
        SelectedSheets.Selected(N) = False
        Next N
    End If
End Sub
Private Sub PrinterButton_Click()
    Application.Dialogs(xlDialogPrinterSetup).Show
End Sub
Private Sub PrintButton_Click()


    Dim vPrev As Boolean
    If PrintPreview.Value = True Then
        vPrev = True
    Else
        vPrev = False
    End If
    
    With SelectedSheets
        For N = 0 To .ListCount - 1
        If .Selected(N) = True Then
            If SheetsToPrint = vbNullString Then
                SheetsToPrint = """" & .List(N) & """"
            Else
                SheetsToPrint = SheetsToPrint & ", " & """" & .List(N) & """"
            End If
        End If
        Next N
        ' Debug
        MsgBox "Print Array:" & vbCrLf & SheetsToPrint
        Me.Hide
    End With
    
    ' Color Config
    If Original.Value = True Then
        Dim sht As Worksheet
        For Each sht In Worksheets(Array(SheetsToPrint))
        With sht.PageSetup
            .BlackAndWhite = False
        End With
        Next
    
        ' Print Original in single print job
        With Worksheets(Array(SheetsToPrint))
            .PrintOut preview:=vPrev
        End With
    End If
    
    ' Grayscale Config
    If Copy.Value = True Then
        Dim shtBW As Worksheet
        For Each shtBW In Worksheets(Array(SheetsToPrint))
        With shtBW.PageSetup
            .BlackAndWhite = True
        End With
        Next
    
        ' Print Grayscale in single print job
        With Worksheets(Array(SheetsToPrint))
            .PrintOut preview:=vPrev
        End With
    End If
</code>End [COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR]

I´ve tried many combinations and search a lot, but no luck. Any advise is very welcome. I suspect the problem has something to do with dimensions of SheetsToPrint, but I wasn't able to correct it myself.
This is my excel file: https://www6.zippyshare.com/v/H02nqoxN/file.html
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
This seems like it should work...
Code:
Dim SheetsToPrint() as Variant
'SheetsToPrint() = Array("Sheet1","Sheet2")
For Cnt = LBound(SheetsToPrint) To UBound(SheetsToPrint)
Worksheets(Array(cnt)).PrintOut preview:=True
Next Cnt
HTH. Dave
 
Upvote 0
Well U haven't declared the array SheetsToPrint and U haven't put anything in it. Not sure why you're selecting/unselecting sheets? Is "SelectedSheets" the name of the listbox?
Trial (untested)...
Code:
With SelectedSheets
 For N = 0 To .ListCount - 1
   If .Selected(N) = True Then
  SheetsToPrint(N) = .List(N)            
   Else
  SheetsToPrint(N) = vbnullstring                           
End if
 Next N
End With
Me.Hide

' Color Config
If Original.Value = True Then
For Cnt = LBound(SheetsToPrint) To UBound(SheetsToPrint)
If SheetsToPrint(cnt) <> vbnullstring  then
        With SheetsToPrint(cnt).PageSetup
            .BlackAndWhite = False
            .PrintOut preview:= True  
        End With
End if
Next cnt
End If
I didn't adjust the Grayscale Config but it will be similar to the colour code. Dave
 
Upvote 0
I´ve tried many combinations and search a lot, but no luck. Any advise is very welcome. I suspect the problem has something to do with dimensions of SheetsToPrint, but I wasn't able to correct it myself.
This is my excel file: https://www6.zippyshare.com/v/H02nqoxN/file.html

Instead of Array function you might want to use Split function, it's simpler, like this:

Code:
   With SelectedSheets
        For n = 0 To .ListCount - 1
            If .Selected(n) = True Then
                    SheetsToPrint = SheetsToPrint & ":" & .List(n)
            End If
        Next n
        SheetsToPrint = Right(SheetsToPrint, Len(SheetsToPrint) - 1)
        arr = Split(SheetsToPrint, ":")
        Me.Hide
    End With

Then you can use it like this:

Code:
    If Original.Value = True Then
        Dim sht As Worksheet
        For Each x In arr
            Sheets(x).PageSetup.BlackAndWhite = False
        Next
    
        ' Print Original in single print job
        For Each x In arr
            Sheets(x).PrintOut preview:=vPrev
        Next
    End If
 
Upvote 0
I like that much better Akuini. Dim SheetsToPrint as String and arr() as Variant for paradadf. Dave
 
Upvote 0
Try this.
Code:
Option Explicit

Private Sub UserForm_Initialize()
Dim N As Long
    Do
    N = N + 1
    If Sheets(N).Visible = True Then
        SelectedSheets.AddItem Sheets(N).Name
    End If
    Loop Until N = Worksheets.Count
End Sub

Private Sub SelectAll_Click()
Dim N As Long

    For N = 0 To SelectedSheets.ListCount - 1
            SelectedSheets.Selected(N) = SelectAll.Value
    Next N
    
End Sub

Private Sub PrinterButton_Click()
    Application.Dialogs(xlDialogPrinterSetup).Show
End Sub

Private Sub PrintButton_Click()
Dim sht As Worksheet
Dim vPrev As Boolean
Dim SheetsToPrint()
Dim cnt As Long

    vPrev = PrintPreview.Value = True
        
    With SelectedSheets
        ReDim SheetsToPrint(1 To .ListCount)
        
        For N = 0 To .ListCount - 1
            If .Selected(N) = True Then
                cnt = cnt + 1
                SheetsToPrint(cnt) = .List(N)
            End If
        Next N
    
    End With
    
    If cnt > 0 Then
        ReDim Preserve SheetsToPrint(1 To cnt)
        MsgBox "Print Array:" & vbCrLf & Join(SheetsToPrint, vbCrLf)
        Me.Hide
    Else
        MsgBox "No sheets selected to print!"
        Exit Sub
    End If
    ' Color Config
    If Original.Value = True Then
    
        For Each sht In Worksheets(SheetsToPrint)
            With sht.PageSetup
                .BlackAndWhite = False
            End With
        Next
    
        ' Print Original in single print job
        With Worksheets(SheetsToPrint)
            .PrintOut Preview:=vPrev
        End With
    End If
    
    ' Grayscale Config
    If Copy.Value = True Then
        
        For Each sht In Worksheets(SheetsToPrint)
            With sht.PageSetup
                .BlackAndWhite = True
            End With
        Next sht
    
        ' Print Grayscale in single print job
        With Worksheets(SheetsToPrint)
            .PrintOut Preview:=vPrev
        End With
    End If
    
End Sub
 
Last edited:
Upvote 0
@Akuini, @NdNoviceHlp and @Norie Thank you very much for your help! I didn't test yours Dave because of your comment:
I like that much better Akuini. Dim SheetsToPrint as String and arr() as Variant for paradadf. Dave
, as using the split function allows me to have Sheet names with every allowed sign, in my case Commas (,).
I had to make a little modification to Akunui's code to have a single print job. The "final" working code using your suggestion looks like this:

Code:
Private Sub UserForm_Initialize()
    Dim N As Integer
    Do
    N = N + 1
    If Sheets(N).Visible = True Then
        SelectedSheets.AddItem Sheets(N).Name
    End If
    Loop Until N = Worksheets.Count
End Sub
Private Sub SelectAll_Click()
    Dim N As Single
    If SelectAll.Value = True Then
        For N = 0 To SelectedSheets.ListCount - 1
            SelectedSheets.Selected(N) = True
        Next N
    Else
        For N = 0 To SelectedSheets.ListCount - 1
            SelectedSheets.Selected(N) = False
        Next N
    End If
End Sub
Private Sub PrinterButton_Click()
    Application.Dialogs(xlDialogPrinterSetup).Show
End Sub
Private Sub PrintButton_Click()
 
    Dim vPrev As Boolean
    If PrintPreview.Value = True Then
        vPrev = True
    Else
        vPrev = False
    End If
   
    With SelectedSheets
        For N = 0 To .ListCount - 1
            If .Selected(N) = True Then
                SheetsToPrint = SheetsToPrint & ":" & .List(N)
            End If
        Next N
        If SheetsToPrint = vbNullString Then
            MsgBox "No sheets selected!"
            Exit Sub
        Else
            SheetsToPrint = Right(SheetsToPrint, Len(SheetsToPrint) - 1)
        End If
        If Original.Value = False And Copy.Value = False Then
            MsgBox "Missing type of print!"
            Exit Sub
        End If
        Arr = Split(SheetsToPrint, ":")
        Me.Hide
    End With
   
    ' Color Config
    If Original.Value = True Then
        For Each x In Arr
            Sheets(x).PageSetup.BlackAndWhite = False
        Next
        ' Print Original in single print job
        Sheets(Arr).PrintOut Preview:=vPrev
        ' Go to first Sheet
        ActiveWorkbook.Worksheets(1).Activate
    End If
   
    ' Grayscale Config
    If Copy.Value = True Then
        For Each x In Arr
            Sheets(x).PageSetup.BlackAndWhite = True
        Next
        ' Print Copy in single print job
        Sheets(Arr).PrintOut Preview:=vPrev
        ' Go to first Sheet
        ActiveWorkbook.Worksheets(1).Activate
    End If

End Sub

And Norie's suggestion was only missing a variable declaration because of the Option Explicit. I added here and before also a check when no print type, i.e. Original or Copy, is checked. The "final" version here looks this way:

Code:
Option Explicit
 
Private Sub UserForm_Initialize()
Dim N As Long
    Do
    N = N + 1
    If Sheets(N).Visible = True Then
        SelectedSheets.AddItem Sheets(N).Name
    End If
    Loop Until N = Worksheets.Count
End Sub
 
Private Sub SelectAll_Click()
Dim N As Long
 
    For N = 0 To SelectedSheets.ListCount - 1
            SelectedSheets.Selected(N) = SelectAll.Value
    Next N
   
End Sub
 
Private Sub PrinterButton_Click()
    Application.Dialogs(xlDialogPrinterSetup).Show
End Sub
 
Private Sub PrintButton_Click()
Dim sht As Worksheet
Dim vPrev As Boolean
Dim SheetsToPrint()
Dim N As Long
Dim cnt As Long
 
    vPrev = PrintPreview.Value = True
       
    With SelectedSheets
        ReDim SheetsToPrint(1 To .ListCount)
       
        For N = 0 To .ListCount - 1
            If .Selected(N) = True Then
                cnt = cnt + 1
                SheetsToPrint(cnt) = .List(N)
            End If
        Next N
   
    End With
   
    If cnt > 0 Then
        ReDim Preserve SheetsToPrint(1 To cnt)
        ' MsgBox "Print Array:" & vbCrLf & Join(SheetsToPrint, vbCrLf)
    Else
        MsgBox "No sheets selected to print!"
        Exit Sub
    End If
    If Original.Value = False And Copy.Value = False Then
        MsgBox "Missing type of print!"
        Exit Sub
    End If
    Me.Hide
   
    ' Color Config
    If Original.Value = True Then
   
        For Each sht In Worksheets(SheetsToPrint)
            With sht.PageSetup
                .BlackAndWhite = False
            End With
        Next
   
        ' Print Original in single print job
        With Worksheets(SheetsToPrint)
            .PrintOut Preview:=vPrev
        End With
    End If
   
    ' Grayscale Config
    If Copy.Value = True Then
       
        For Each sht In Worksheets(SheetsToPrint)
            With sht.PageSetup
                .BlackAndWhite = True
            End With
        Next sht
   
        ' Print Grayscale in single print job
        With Worksheets(SheetsToPrint)
            .PrintOut Preview:=vPrev
        End With
    End If
   
End Sub

The only remaining issue I'm facing right now is that the Print Preview doesn't always show all images I have in different sheets. Usually the "Color Preview" looks perfect, but the "Black and White Preview" misses some pictures (or part of pictures).

Again, I'm very grateful for the help you've given me. Thank you very much!!!
 
Upvote 0

Forum statistics

Threads
1,223,889
Messages
6,175,226
Members
452,620
Latest member
dsubash

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top