Igor67, для меня все это вообще П[олтергейст] полный..
Вот еще один прикол, - использую образец кода для построения СТ в других файлах, в двух всё ровно, в 3-й никак...
Option Explicit
Sub SVOD()
Dim bazaWb As Workbook 'текущая книга (общий файл)
Dim bazaSht As Worksheet 'лист Baza в общем файле
Dim pvtSht As Worksheet 'лист для сводной в общем файле
Dim PTCache As PivotCache 'переменная для записи исходных данных сводной табл
Dim PT As PivotTable 'переменная сводной табл
Dim myCountA As Integer
Dim myPvtRng As Range
Set bazaWb = ThisWorkbook
Set bazaSht = bazaWb.Sheets("valbal")
'On Error Resume Next
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlManual
If Not SheetExit("Итоги") Then
Set pvtSht = Sheets.Add
pvtSht.Name = "Итоги"
Else: Set pvtSht = bazaWb.Sheets("Итоги")
End If
myCountA = Excel.WorksheetFunction.CountA(pvtSht.Range("A1:A2000"))
'очищаем лист с данными сводной таблицы
If myCountA > 0 Then
With pvtSht
.Range(.Cells(1, 1), .Cells(bazaSht.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, Columns.Count).End(xlToLeft).Column)).Cells.Clear
End With
End If
'создаем кэш для сводной таблицы с ячейки А1 до правой нижней в таблице
' Set myPvtRng = bazaSht.Range(bazaSht.Cells(1, 1), bazaSht.Cells(bazaSht.Cells(Rows.Count, 1).End(xlUp).Row, bazaSht.Cells(bazaSht.Cells(Rows.Count, 1).End(xlUp).Row, Columns.Count).End(xlToLeft).Column))
' bazaSht.Activate
' Debug.Print myPvtRng.Address
' Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
' SourceData:=myPvtRng.Address)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=Sheets("valbal").Range("A2").CurrentRegion.Address) 'можно явно указывать расположение исходных данных
Set PT = PTCache.CreatePivotTable(TableDestination:=pvtSht.Range("A2"), TableName:="СводнаяТаблица1")
With PT 'создаем саму сводную таблицу
.PivotFields("Код вал.").Orientation = xlColumnField
.PivotFields("Продукт").Orientation = xlRowField
.PivotFields("Входящий (КП)").Orientation = xlDataField
.PivotFields("Оборот (ДП)").Orientation = xlDataField
End With
With PT.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
pvtSht.Activate
With PT
.PivotFields("Сумма по полю Входящий (КП)").Caption = "Входящий оборот"
.PivotFields("Сумма по полю Оборот (ДП)").Caption = "Оборот по К-ту"
End With
'включаем все, что отключали
.Calculation = xlAutomatic
.DisplayAlerts = True
.ScreenUpdating = False
End With
End Sub
Private Function SheetExit(iSheet As String)
On Error Resume Next
With Sheets(iSheet): End With
SheetExit = (Err = 0)
End Function
С ошибкой Application-defined or object-defined error справиться я не могу.
