Printing multiple ranges/charts from different sheets at the same time?

[cwb1021]

Good Morning Experts,

I was curious if it were possible to print ranges and charts from multiple worksheets in the same workbook with only one print command?

So say I have a workbook with sheets 1 - 3 and I want to print the used range in sheets 1 and 2, and charts 1 and 2 on sheet 3 at the same time.

So far my attempts have printed the last selection only. I have also though that maybe I could set each print area / chart as a variable and store them in an array?

I've used the following code. This does not work but I think demonstrates what I would like to do.


Private Sub PDFButton1_Click()
Dim BStats As Range, AvStats As Range
Dim C1 As ChartObject, C2 As ChartObject
Dim PrintArray As Variant

UserForm1.Hide
Set AvStats = Worksheets("AverageStats").UsedRange
Set BStats = Worksheets("BHASTats").UsedRange
C1 = Sheets("Charts").ChartObjects("Chart 2")
C2 = Sheets("Charts").ChartObjects("Chart1")
PrintArray = (AvStats, BStats, C1, C2)
ActiveWindow.SelectedSheets.PrintPreview ' <=== not sure what should go here
UserForm1.Show
End Sub


And ideas?

Thanks!

Chris

[mdmackillop]

Can you put together a sample workbook.

[cwb1021]

Good morning mdmackillop,

The workbook I was using was very large, so ive attached a sample with worksheets of the same name.

Also, I have found this bit of code here http://www.vbaexpress.com/kb/getarticle.php?kb_id=197 which is a partial solution.


Sub SelectAllSheets()

Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Sheets
'False to extend the current selection to include
' any previously selected objects and the specified object
ws.Select False

Next ws

Application.ScreenUpdating = True

End Sub


This selects all worksheets in a workbook, and from there I could just print. The problems with this are that I only need to print from a few of the sheets in the workbootk, and for the Charts worksheet, I only want to print the charts, not the entire worksheet.

Thanks for the response!

Chris

[mdmackillop]

This will export the charts to separate sheets for printing, then clean up

Sub PrintArray()
Dim PrintArray() As Variant
Dim i As Long, x as long, y as long
Dim ws As Worksheet
Dim CO As Object


ReDim PrintArray(1)
PrintArray(0) = "AverageStats"
PrintArray(1) = "BHASTats"
y = UBound(PrintArray) + 1

Sheets("Charts").Copy After:=Sheets(Worksheets.Count)
Set ws = ActiveSheet
For Each CO In ws.ChartObjects
x = UBound(PrintArray) + 1
ReDim Preserve PrintArray(x)
CO.Chart.Location Where:=xlLocationAsNewSheet
PrintArray(x) = ActiveSheet.Name
Next


Sheets(PrintArray).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False


Application.DisplayAlerts = False
For i = y To UBound(PrintArray)
Sheets(PrintArray(i)).Delete
Next i
ws.Delete
Application.DisplayAlerts = True


End Sub

[cwb1021]

mdmackillop,

This works great in the worksheet I had attached before. However, as I mentioned earlier I wanted to use this in a separate workbook. But when I do, it throws and error at the Sheets(printArray).select line (below).


For Each CO In ws.ChartObjects
x = UBound(PrintArray) + 1
ReDim Preserve PrintArray(x)
CO.Chart.Location Where:=xlLocationAsNewSheet
PrintArray(x) = ActiveSheet.Name
Next


Sheets(PrintArray).Select '<=====================Run-time error '9':
'subscript out of range

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

I've been playing around with this a bit, but have not been able to get it to work. If I replace the Sheets(PrintArray).select with Sheets(printArray(x)).select, or any other element in the array, the procedure will continue to the end but of course, will only print one element.

I've attached the actual workbook I would like to use, and just deleted all of the other worksheets that were not relevant to this procedure to make it smaller. Sorry, I probably should have done this to begin with.

Any thoughts on what the error is in reference to?

Thanks,

Chris

[mdmackillop]

It's a "Spot the Difference" competition - AverageStats, AveragedStats.

Sub PrintArrayExternal()
Dim PrintArray() As Variant
Dim i As Long, x As Long, y As Long
Dim ws As Worksheet
Dim CO As Object
Dim WB As Workbook


On Error Resume Next
Set WB = Workbooks("PrintSampleAgain.xlsm")
If WB Is Nothing Then
Set WB = Workbooks.Open("C:\VBAX\PrintSampleAgain.xlsm")
End If
On Error GoTo 0


ReDim PrintArray(1)
PrintArray(0) = "AveragedStats"
PrintArray(1) = "BHAStats"
y = UBound(PrintArray) + 1


WB.Sheets("Charts").Copy After:=Sheets(WB.Worksheets.Count)
Set ws = ActiveSheet
For Each CO In ws.ChartObjects
x = UBound(PrintArray) + 1
ReDim Preserve PrintArray(x)
CO.Chart.Location Where:=xlLocationAsNewSheet
PrintArray(x) = ActiveSheet.Name
Next


WB.Sheets(PrintArray).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Application.DisplayAlerts = False
For i = y To UBound(PrintArray)
WB.Sheets(PrintArray(i)).Delete
Next i
ws.Delete
Application.DisplayAlerts = True
End Sub