'--------------------------------------------------------------------------------------

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

'задать имена для сводных и для временных шкал

Dim strSL_Main As String, strSL_ChLd As String

Select Case Target

Case "pt_Main" 'имя сводной

strSL_Main = "SL_Date_Main"

strSL_ChLd = "SL_Date_ChLd"

Case "pt_ChLd" 'имя сводной

strSL_Main = "SL_Date_ChLd"

strSL_ChLd = "SL_Date_Main"

Case Else

Call EventsChange(True)

Exit Sub

End Select

Call EventsChange(False)

'синхронизация по временной шкале

': StartDate : #01.09.2020# : Variant/Date

': EndDate : #30.09.2020# : Variant/Date

Set oSL_Main = ThisWorkbook.SlicerCaches(strSL_Main)

Set oSL = ThisWorkbook.SlicerCaches(strSL_ChLd)

Dim Lng_FilterType As Long

On Error GoTo Err_Slicer_FilterType

Lng_FilterType = oSL_Main.TimelineState.FilterType '(35)= xlDateBetween

Err_Slicer_FilterType:

If Lng_FilterType = 0 Then

'сброс

ThisWorkbook.SlicerCaches(strSL_ChLd).ClearDateFilter

Call ThisWorkbook.SlicerCaches("SL_Date_Main_Week").ClearDateFilter

Call ThisWorkbook.SlicerCaches("SL_Date_ChLd_Week").ClearDateFilter

Call ThisWorkbook.SlicerCaches("SL_Date_Main_Month").ClearDateFilter

Call ThisWorkbook.SlicerCaches("SL_Date_ChLd_Month").ClearDateFilter

Else

Call oSL.TimelineState.SetFilterDateRange(oSL_Main.TimelineState.StartDate, oSL_Main.TimelineState.EndDate)

Dim dDateStart As Date

Dim dDateEnd As Date

''первый-последний день недели

dDateStart = Format(fun_FirstDayInWeek(oSL_Main.TimelineState.StartDate), "DD.MM.YYYY") 'первый день недели(FirstDayInWeek)

dDateEnd = Format(fun_LastDayInWeek(oSL_Main.TimelineState.StartDate), "DD.MM.YYYY") 'последний день недели(LastDayInWeek)

Call ThisWorkbook.SlicerCaches("SL_Date_Main_Week").TimelineState.SetFilterDateRange(dDateStart, dDateEnd)

Call ThisWorkbook.SlicerCaches("SL_Date_ChLd_Week").TimelineState.SetFilterDateRange(dDateStart, dDateEnd)

''первый-последний день месяца

dDateStart = DateSerial(Year(dDateStart), Month(dDateStart), 1)

dDateEnd = Format(fun_LastDayInMonth(dDateStart), "DD.MM.YYYY")

Call ThisWorkbook.SlicerCaches("SL_Date_Main_Month").TimelineState.SetFilterDateRange(dDateStart, dDateEnd)

Call ThisWorkbook.SlicerCaches("SL_Date_ChLd_Month").TimelineState.SetFilterDateRange(dDateStart, dDateEnd)

End If

Call EventsChange(True)

End Sub

'--------------------------------------------------------------------------------

'первый день недели(FirstDayInWeek)

Function fun_FirstDayInWeek(ByVal dDate As Date) As Date

Dim intDay As Integer

If TypeName(dDate) = "Date" Then

intDay = DatePart("w", dDate, 0, 0)

fun_FirstDayInWeek = Format(dDate - intDay + 1, "DD.MM.YYYY")

End If

End Function

'последний день недели(LastDayInWeek)

Function fun_LastDayInWeek(ByVal dDate As Date) As Date

Dim intDay As Integer

If TypeName(dDate) = "Date" Then

intDay = DatePart("w", dDate, 0, 0)

fun_LastDayInWeek = Format(dDate + 7 - intDay, "DD.MM.YYYY")

End If

End Function

'последний день месяца

Function fun_LastDayInMonth(ByVal dDate As Date) As Date

Dim intDay As Integer

Dim intYear As Integer

Dim intMonth As Integer

If TypeName(dDate) = "Date" Then

intMonth = Month(dDate) + 1

intYear = Year(dDate)

If intMonth = 13 Then

intMonth = 1

intYear = intYear + 1

End If

fun_LastDayInMonth = DateSerial(intYear, intMonth, 0)

' fun_LastDayInMonth = Day(lastDate) '31

End If

End Function

'--------------------------------------------------------------------------------------