Sub CreatePT(ByRef wbConnect As Object, _

ByVal strShPtMainName As String, _

ByVal strDataName As String, _

ByVal TypeAnalis As String)

Dim PTCache As PivotCache

Dim pt As PivotTable

Dim ShPt As Worksheet

'strDataName = "DPU"

'strShPtMainName = "PTmain_" & strDataName

With wbConnect

' On Error Resume Next

' .Sheets(strShPtMainName).Delete

' DeleteSh strShPtMainName

.Sheets.Add Before:=Sheets(1)

Set ShPt = .Sheets(1)

If wbConnect.Name = ThisWorkbook.Name Then .Sheets(1).Visible = False

' Создание области кэша

Set PTCache = .PivotCaches.Create(SourceType:=xlExternal, SourceData:= _

.Connections(strDataName & "New"))

With ShPt '.Sheets(strShPtMainName)

.Name = strShPtMainName '& "1"

.Cells.Clear

'Создание сводной таблицы

' Set PT = Sheets(1).PivotTables(1)

Set pt = .PivotTables.Add( _

PivotCache:=PTCache, TableName:=strShPtMainName, _

TableDestination:=ShPt.Range("A1"))

''' With pt

'''' .PivotCache = PTCache

'''' .TableName = strShName

''' .InGridDropZones = True

''' .RowAxisLayout xlTabularRow

'''' .Orientation = xlPageField

'''' .Orientation = xlColumnField

'''' .Orientation = xlRowField

'''' .Orientation = xlDataField

'''' AutoSort xlDescending, " TDef"

'''' pt.PivotFields("Модель").Orientation = xlColumnField

''' With pt.PivotFields(TypeAnalis)

''' .Orientation = xlDataField

''' .Function = xlSum

''' .Caption = " " & TypeAnalis

''' End With

''' If TypeAnalis <> "Prod" Then

''' With .PivotFields("Объединенные_поля")

''' .Orientation = xlRowField

''' .AutoSort xlDescending, " " & TypeAnalis

''' End With

''' End If

''' .PivotFields("Год").Orientation = xlColumnField

'''' 'заголовки полей отсутствуют

'''' .DisplayFieldCaptions = False

''' End With

' .Visible = xlSheetHidden

' .Visible = xlSheetVisible

End With

'ShPt.Visible = False

Set pt = Nothing

Set PTCache = Nothing

Set ShPt = Nothing

End With

'EventsChange True

'Stop

End Sub

Sub IditIndexPT(ByVal strShPtMainName As String, ByVal strShPtName As String)

'перекидываем кеш (по индексу)

Dim pt As PivotTable

'Set PT = ThisWorkbook.Sheets("PTmain_DPU").PivotTables(1)

'FF = PT.CacheIndex

With ThisWorkbook.Sheets(strShPtName)

For pivotNb = 1 To .PivotTables.Count

Set pt = .PivotTables(pivotNb)

' Stop

With pt

'http://www.excelforum.com/l/735371-asdf.html

.CacheIndex = Sheets(strShPtMainName).PivotTables(1).CacheIndex

' .PivotTableWizard SourceType:=xlPivotTable, SourceData:="PTmainDPU"

End With

Set pt = Nothing

Next pivotNb

End With

End Sub