I found a vba code that I copied on this forum that lopps through a slicer and selects / deselects each name and bring up the relevant data for that person and prints it. It works but for some reason it keeps creating prints about 104 pages when there are only 39 names in the slicer. The last prints are just some empty boxes. When I manually choose a name in the slicer and preview the printout it shows as 1 page so I should only have 39 pages in total. Why does it not stop?
This is the code that I am using. ( I also added a shape that covers up the slicer and when finished deletes it because even though it picks the next name from the slicer it doesn't actually move the slicer to show that name and so it looks wrong in the print out.)
I hope someone will have an idea why it is happening.
Sub Step_Thru_SlicerItems2()
Dim slItem As SlicerItem
Dim i As Long
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 367.8, 3.6, 159, 54).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Name = "WhiteSquare"
Selection.Name = "WhiteSquare"
Application.ScreenUpdating = False
With ActiveWorkbook.SlicerCaches("Slicer_Student")
'--deselect all items except the first
.SlicerItems(1).Selected = True
For Each slItem In .VisibleSlicerItems
If slItem.Name <> .SlicerItems(1).Name Then _
slItem.Selected = False
Next slItem
Call MyFunction(1)
'--step through each item and run custom function
For i = 2 To .SlicerItems.Count
.SlicerItems(i).Selected = True
.SlicerItems(i - 1).Selected = False
Call MyFunction(i)
Next i
End With
Application.ScreenUpdating = True
ActiveSheet.Shapes.Range(Array("WhiteSquare")).Select
Selection.Delete
End Sub
Function MyFunction(lItem As Long)
Dim wsPivot As Worksheet
Dim lNextRow As Long
Const lRowsPerPic As Long = 11
lNextRow = (lItem - 1) * lRowsPerPic + 1
Sheets("SemReport").PrintOut Copies:=1, Collate:=True, ignorePrintAreas:=False
End Function
This is the code that I am using. ( I also added a shape that covers up the slicer and when finished deletes it because even though it picks the next name from the slicer it doesn't actually move the slicer to show that name and so it looks wrong in the print out.)
I hope someone will have an idea why it is happening.
Sub Step_Thru_SlicerItems2()
Dim slItem As SlicerItem
Dim i As Long
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 367.8, 3.6, 159, 54).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Name = "WhiteSquare"
Selection.Name = "WhiteSquare"
Application.ScreenUpdating = False
With ActiveWorkbook.SlicerCaches("Slicer_Student")
'--deselect all items except the first
.SlicerItems(1).Selected = True
For Each slItem In .VisibleSlicerItems
If slItem.Name <> .SlicerItems(1).Name Then _
slItem.Selected = False
Next slItem
Call MyFunction(1)
'--step through each item and run custom function
For i = 2 To .SlicerItems.Count
.SlicerItems(i).Selected = True
.SlicerItems(i - 1).Selected = False
Call MyFunction(i)
Next i
End With
Application.ScreenUpdating = True
ActiveSheet.Shapes.Range(Array("WhiteSquare")).Select
Selection.Delete
End Sub
Function MyFunction(lItem As Long)
Dim wsPivot As Worksheet
Dim lNextRow As Long
Const lRowsPerPic As Long = 11
lNextRow = (lItem - 1) * lRowsPerPic + 1
Sheets("SemReport").PrintOut Copies:=1, Collate:=True, ignorePrintAreas:=False
End Function