MyTetra Share
Делитесь знаниями!
Pt_разное
07.09.2017
10:42
Раздел: VBA - Сводные

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

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



Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования