Исправлена ​​петля через слайсер в сводной таблице, которая печатает слишком много страниц / не останавливается на последнем элементе в слайсере - PullRequest
Новая
       28

Исправлена ​​петля через слайсер в сводной таблице, которая печатает слишком много страниц / не останавливается на последнем элементе в слайсере

0 голосов
/ 22 января 2019

Я нашел скопированный код vba, который проходит через слайсер и выбирает / отменяет выбор каждого имени, заполняет сводную таблицу данными этого человека и затем печатает их.Это работает, но по какой-то причине продолжает отправлять страницы на принтер.Он создает около 104 страниц, когда в слайсере всего 39 имен.Я на самом деле не печатал все страницы, потому что в моем принтере было мало чернил, но я мог видеть, сколько документов было в очереди на печать.Я напечатал первые несколько и последние 2, остальные я удалил.На последних 2 отпечатках были только пустые коробки.Я не уверен, что это поднимает.Когда я вручную выбираю имя в слайсере и просматриваю распечатку, она отображается как 1 страница, поэтому у меня должно быть всего 39 страниц.Почему это не останавливается?

Пожалуйста, смотрите ниже код, который я использую.Вначале я также добавляю фигуру, которая закрывает слайсер, а по окончании печати удаляет его, потому что, хотя он выбирает следующее имя из слайсера, он фактически не перемещает слайсер, чтобы показать это имя, и поэтому он выглядит неправильно враспечатай.

Надеюсь, у кого-нибудь появится идея, почему это происходит. 

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
...