Ошибка времени выполнения 1004 при создании сводной диаграммы из макроса - PullRequest
0 голосов
/ 30 января 2019

Я написал макрос для добавления сводной диаграммы в Excel.Я получаю

Ошибка приложения или объекта

в следующей строке.Кто-нибудь может мне помочь с этим?

Set DSheet = ActiveWorkbook.Worksheets("Sheet1")
Worksheets("Sheet1").Activate
LastRow = DSheet.Cells(DSheet.Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, DSheet.Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

Table1_Start_Line = 2
Table1_End_Line = Table1_Start_Line + LastRow
Column_Line = LastCol + 2
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange, Version:=xlPivotTableVersion15).CreatePivotTable TableDestination:=DSheet.Cells(Table1_Start_Line, Column_Line), TableName:="PivotTable", DefaultVersion:=xlPivotTableVersion15

1 Ответ

0 голосов
/ 30 января 2019

Я думаю, этот код будет делать то, что вы хотите.По сути, он удаляет существующую таблицу перед вставкой новой.

Private Sub RenewPivotTable()

    Dim DSheet As Worksheet
    Dim PTable As PivotTable
    Dim LastRow As Long, LastCol As Long
    Dim PRange As Range
    Dim Table1_Start_Line As Long, Column_line As Long

    Set DSheet = ActiveWorkbook.Worksheets("Sheet1")
    With DSheet
        If .PivotTables.Count Then
            .PivotTables(1).TableRange2.Clear
        End If
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set PRange = .Cells(1, 1).Resize(LastRow, LastCol)
    End With

    Table1_Start_Line = 2
    Column_line = LastCol + 2
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                      SourceData:=PRange, _
                                      Version:=xlPivotTableVersion15).CreatePivotTable _
                                      TableDestination:=DSheet.Cells(Table1_Start_Line, Column_line), _
                                      TableName:="PivotTable", _
                                      DefaultVersion:=xlPivotTableVersion15
End Sub

Я тестировал ее версию 14 в Excel 2010

...