'### Цикл листам книги (с условием в имени(или без))

Function FnEachShInWb(ByVal strName As String) As Boolean

'strName - часть имени листа

Dim iNbError As Long

On Error Resume Next

For Each oSh In ThisWorkbook.Sheets 'цикл по всем листам книги

If Len(strName) > 0 Then 'если условие по имени листа задано

If oSh.Name Like "Pv_*" Then

Debug.Print oSh.Index & " " & oSh.Name

'запустить процедуру

End If

Else

'запустить процедуру

End If

'проверка на ошибку

iNbError = Err.Number

If iNbError > 0 Then

FnEachShInWb = False

Else

FnEachShInWb = True

End If

Next 'oSh

End Function

'### Цикл по сводным таблицам листа

Function FnEachPtInSh(ByVal strShName As String) As Boolean

Dim oSh As Worksheet

Dim oPt As PivotTable

oSh = ThisWorkbook.Sheets(strShName)

On Error Resume Next

With oSh

If .PivotTables.Count > 0 Then

For Each Pt In .PivotTables 'цикл по всем сводным таблицам

Set oPt = Pt

With oPt

For Each Pf In .PivotFields 'скинуть все поля

' dd = Pf.Orientation

' Debug.Print Pf & " ======= " & dd

Pf.Orientation = xlHidden

Next 'Pf

Set Pf = Nothing

End With

Next 'Pt

FnEachPtInSh = True

Else

FnEachPtInSh = False: Stop

End If

End With

End Function

'### Цикл по полям сводной

Function FnEachPfInPt(ByVal oPt) As Boolean

Dim oPf As PivotField

With oPt

For Each Pf In .PivotFields 'скинуть все поля

Set oPf = Pf

oPf.Orientation = xlHidden

Next 'Pf

Set Pf = Nothing

End With

Next 'Pt

End With

End Function

'### Разобрать сводные таблицы

Function FnDelFieldsAllSh() '(ByVal strShName As String)

On Error Resume Next

For Each oSh In ThisWorkbook.Sheets 'цикл по всем листам книги

If oSh.PivotTables.Count > 0 Then

Debug.Print oSh.Name & " ======================================="

For Each oPt In oSh.PivotTables 'цикл по всем сводным таблицам

Set Pt = oPt

With Pt

' ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Месяц_Decl"). _

Orientation = xlHidden

For Each Pf In .PivotFields 'скинуть все поля

' dd = Pf.Orientation

' Debug.Print Pf & " ======= " & dd

Pf.Orientation = xlHidden

Next 'Pf

Set Pf = Nothing

End With

Next 'oPt

End If

Next 'oSh

End Function