'выбор типа элементов в словаре

Function FnDicItems(ByVal strType As String, _

ByVal strItems As String) As Variant

Select Case strType

Case "Даты": Set vDicItems = FnDicFilterDate(strItems)

Case "Текст": Set vDicItems = FnDicFilterString(strItems)

Case Else:

End Select

Set FnDicItems = vDicItems

End Function

Function FnStatusBar(ByVal strValue As Variant) As Boolean

Application.StatusBar = strValue

End Function

'##### изменение фильтра по словарю значений

'1 если пусто - скидываем фильтр

'2 если одно значение - выставляем

'3 если набор - перебор циклом

Function FnChangeFilter(ByVal strType As String, _

ByVal vDicItems As Variant, _

ByVal oPt As PivotTable, _

ByVal strPf As String, _

Optional ByVal iPf As Integer = 3, _

Optional ByVal blnValue As Boolean = True)

'blnValue - включаме или наоборот отключаем

'strType - тип (поле с датами или текстовое)

'oPt - сводная

'strPf - имя поля с датами

'iPf - ориентация

' 0 .Orientation = xlHidden

' 1 .Orientation = xlPageField - фильтр

' 2 .Orientation = xlRowField - строки

' 3 .Orientation = xlColumnField - столбцы

Dim iNbItem As Long, iNbItems As Long 'счетчики

Dim iNbDicItems As Long

Dim strItemValue As Boolean, strItem As String

Dim strTypeItems As String 'тип переменной с элементами

With oPt

iNbDicItems = vDicItems.Count 'определяем количество элементов в словаре

' .ManualUpdate = True

' Application.Calculation = xlCalculationManual

Set oPf = .PivotFields(strPf)

With oPf

iNbItem = 0

iNbItems = .PivotItems.Count

'проверяем расположение поля

If .Orientation > 0 Then .Orientation = 0 'сначала скидываем,

.Orientation = iPf 'потом бросаем в заданную область

If blnValue = False Then iNbDicItems = 2 'нельзя выставить все кроме одного за один шаг _

поэтому обработка циклом (Case Else)

Select Case iNbDicItems

Case 0

'если интервал не задан(для сброса фильтра)

.ClearAllFilters

' For Each oPi In .PivotItems 'цикл по элементам поля

' oPi.Visible = True 'включаем все элементы

'

' iNbItem = iNbItem + 1

' strValue = oPf & " => " & iNbItem & " / " & iNbItems & " - <" & oPi.Name & ">=True"

' Строка_Состояния = FnStatusBar(strValue)

' Next 'oPf

Case 1 'одно значение

.ClearAllFilters

.EnableMultiplePageItems = False

If iPf <> 3 Then 'разный способ выставления одного значения, в зависимости от расположеия

If strType = "Даты" Then .PivotFilters.Add2 Type:=xlSpecificDate, Value1:=vDicItems.Keys()(0)

If strType = "Текст" Then .PivotFilters.Add2 Type:=xlCaptionEquals, Value1:=vDicItems.Keys()(0)

Else

If strType = "Даты" Then .CurrentPage = FnDateStrPi_RU_EN(vDicItems.Keys()(0))

If strType = "Текст" Then .CurrentPage = vDicItems.Keys()(0)

End If

' gg = UBound(vDicItems.Keys)

' oPt.ManualUpdate = False

Exit Function

Case Else 'словарь

.IncludeNewItemsInFilter = False 'не включать новые элементы в фильтр

.ClearAllFilters

' .CurrentPage = "(All)"

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'' .PivotItems.Item(1).Visible = True 'включить первый элемент(на всякий случай

.EnableMultiplePageItems = True 'выделение нескольких элементов

For Each oPi In .PivotItems 'цикл по элементам поля

strItem = oPi.Name

If vDicItems.exists(strItem) Then 'если элемент есть в словаре

strItemValue = blnValue

Else

strItemValue = Not blnValue

End If

oPi.Visible = strItemValue

'

iNbItem = iNbItem + 1

'строка состояния

If strItem <> "(blank)" Then

strValue = oPf & " => " & iNbItem & " / " & iNbItems & " - <" & strItem & ">=" & strItemValue

Строка_Состояния = FnStatusBar(strValue)

End If

Next 'oPf

End Select

End With

' .ManualUpdate = False

End With

Строка_Состояния = FnStatusBar(False)

'EventsChange False

'EventsChange True

End Function