Всплывающая копия дубликата электронной таблицы макроса Excel

Question

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

Я прочитал сайты надстроек, чтобы убедиться, что я правильно настроил надстройку.Мои другие надстройки макроса работают (только 2. еще учатся)

Sub OpenAndHoldPivot()

    Dim sht As Worksheet
    Dim pvtCache As PivotCache
    Dim pvt As PivotTable
    Dim StartPvt As String
    Dim SrcData As String

'Determine the data range you want to pivot

    Dim finRow As String
    With ActiveWorkbook
    finRow = ActiveSheet.Range("A200000").End(xlUp).Row
    SrcData = ActiveSheet.Name & "!" & Range("A4:BO" & finRow - 1).Address  (ReferenceStyle:=xlR1C1)
    End With

'Create a new worksheet

    Set sht = Sheets.Add

'Pivot Table Start

    StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data

     Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
     SourceType:=xlDatabase, _
     SourceData:=SrcData)

'Create Pivot table from Pivot Cache

     Set pvt = pvtCache.CreatePivotTable( _
     TableDestination:=StartPvt, _
     TableName:="PivotTable1")

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


    Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Add item to the Report Filter

    pvt.PivotFields("Future Fill Date").Orientation = xlPageField

'Add item to the Column Labels

    pvt.PivotFields("Worker Type").Orientation = xlColumnField

'Add item to the Row Labels

    pvt.PivotFields("Flex Division").Orientation = xlRowField

'Turn on Automatic updates/calculations --like screenupdating to speed up code

    pvt.ManualUpdate = False

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


    ActiveSheet.Name = "Pivot"


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

    Dim pf As String
    Dim pf_Name As String

    pf = "FT/PT"
    pf_Name = "Sum of FT/PT"

    Set pvt = ActiveSheet.PivotTables("PivotTable1")

    pvt.AddDataField pvt.PivotFields("FT/PT"), pf_Name, xlCount

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

    Dim pm As PivotField

    Set pm = ActiveSheet.PivotTables("PivotTable1").PivotFields("Future Fill Date")

'Clear Out Any Previous Filtering

    pm.ClearAllFilters

'Filter on 2014 items

    pm.CurrentPage = "(blank)"
'------------------------------------------------------------------------------


    Sheets("Sheet1").Name = "Data"


End Sub

Есть идеи о том, что я делаю неправильно?

Answer 1

Я действительно думаю, что ваша проблема связана с некоторыми противоречивыми ссылками (или отсутствием ссылок) на то, какую книгу или лист вы используете.В частности, я считаю, что проблема связана со строкой

Set sht = Sheets.Add

Поскольку ваша ссылка Sheets не указывает, к какой книге добавить новый лист, по умолчанию будет активна текущая рабочая книга, которая может быть вашим добавлением.в рабочей тетради.Вы сильно поможете себе, если станете намного яснее о том, какие книги и рабочие листы вам нужны.Чтобы проиллюстрировать это на своем примере, вы можете начать с

Sub OpenAndHoldPivot()
    Dim workingWB As Workbook
    Dim workingWS As Worksheet
    Set workingWB = ActiveWorkbook
    Set workingWS = activeworksheet

    'Determine the data range you want to pivot
    Dim srcData As Range
    Dim srcDataText As String
    With workingWS
        Dim finRow As Long
        finRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set srcData = .Range("A4").Resize(finRow - 1, 67)
        srcDataText = .Name & "!" & srcData.Address(ReferenceStyle:=xlR1C1)
    End With

. Это четко определяет, с какой книгой будет работать весь ваш код.Кроме того, если вы посмотрите на мой With блок и сравните его с вашим, вы увидите, что пропустили . до ссылки Range, которая снова, скорее всего, будет ссылаться либо на вашу надстройку, либо на активнуюрабочая тетрадь (и вы никогда не можете быть слишком уверены.

После этого я просто продолжаю писать код ...

    'Create a new worksheet in the working workbook
    Dim pivotWS As Worksheet
    Set pivotWS = workingWB.Sheets.Add

    'Pivot Table Start
    Dim StartPvtText As String
    StartPvtText = pivotWS.Name & "!" & pivotWS.Range("A3").Address(ReferenceStyle:=xlR1C1)

    'Create Pivot Cache from Source Data
    Dim pvtCache As PivotCache
    Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
                   SourceType:=xlDatabase, _
                   SourceData:=srcDataText)

    'Create Pivot table from Pivot Cache
    Dim pvt As PivotTable
    Set pvt = pvtCache.CreatePivotTable( _
              TableDestination:=StartPvtText, _
              TableName:="PivotTable1")

Обратите также внимание, что я объявляю все свои переменные как можно ближе к их местуиспользуются по возможности. Это значительно облегчает отслеживание и гарантирует, что вы используете правильную переменную с намеченным типом.

Далее, в своем коде вы ссылались на ActiveSheetнесколько раз. Замените это на конкретную ссылку, чтобы быть последовательным. В моем коде я редко использую ActiveSheet или ActiveCell. Я попытался исправить ссылки ниже, здесь, в полном модуле, но только вы можете сказать, еслиэто точно (потому что не совсем понятно, какую книгу или лист вы хотите).

Наконец, есть последняя строка кода Sheets("Sheet1").Name = "Data". Я понятия не имею, на какую книгу следует ссылаться, ноЯ думаю, что это должно быть workingWB.Sheets("Sheet1").Name = "Data".

Option Explicit

Sub OpenAndHoldPivot()
    Dim workingWB As Workbook
    Dim workingWS As Worksheet
    Set workingWB = ActiveWorkbook
    Set workingWS = activeworksheet

    'Determine the data range you want to pivot
    Dim srcData As Range
    Dim srcDataText As String
    With workingWS
        Dim finRow As Long
        finRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set srcData = .Range("A4").Resize(finRow - 1, 67)
        srcDataText = .Name & "!" & srcData.Address(ReferenceStyle:=xlR1C1)
    End With

    'Create a new worksheet in the working workbook
    Dim pivotWS As Worksheet
    Set pivotWS = workingWB.Sheets.Add

    'Pivot Table Start
    Dim StartPvtText As String
    StartPvtText = pivotWS.Name & "!" & pivotWS.Range("A3").Address(ReferenceStyle:=xlR1C1)

    'Create Pivot Cache from Source Data
    Dim pvtCache As PivotCache
    Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
                   SourceType:=xlDatabase, _
                   SourceData:=srcDataText)

    'Create Pivot table from Pivot Cache
    Dim pvt As PivotTable
    Set pvt = pvtCache.CreatePivotTable( _
              TableDestination:=StartPvtText, _
              TableName:="PivotTable1")

    '------------------------------------------------------------------------------
    Set pvt = pivotWS.PivotTables("PivotTable1")

    'Add item to the Report Filter
    pvt.PivotFields("Future Fill Date").Orientation = xlPageField

    'Add item to the Column Labels
    pvt.PivotFields("Worker Type").Orientation = xlColumnField

    'Add item to the Row Labels
    pvt.PivotFields("Flex Division").Orientation = xlRowField

    'Turn on Automatic updates/calculations --like screenupdating to speed up code
    pvt.ManualUpdate = False

    '------------------------------------------------------------------------------
    pivotWS.Name = "Pivot"

    '------------------------------------------------------------------------------
    Dim pf As String
    Dim pf_Name As String
    pf = "FT/PT"
    pf_Name = "Sum of FT/PT"
    Set pvt = pivotWS.PivotTables("PivotTable1")
    pvt.AddDataField pvt.PivotFields("FT/PT"), pf_Name, xlCount

    '------------------------------------------------------------------------------
    Dim pm As PivotField
    Set pm = pivotWS.PivotTables("PivotTable1").PivotFields("Future Fill Date")

    'Clear Out Any Previous Filtering
    pm.ClearAllFilters

    'Filter on 2014 items
    pm.CurrentPage = "(blank)"

    '------------------------------------------------------------------------------
    workingWB.Sheets("Sheet1").Name = "Data"
End Sub