Как предотвратить превращение сводной диаграммы в обычную диаграмму на листовой копии?

используя Excel 2010, я написал некоторые VBA для копирования выбранных листов из главной книги в клиентскую книгу. Код отлично работает, чтобы скопировать лист данных, который имеет данные и сводные таблицы, связанные с данными, и лист диаграммы с одной или несколькими сводными диаграммами в новую книгу.

проблема в том, что в книге назначения диаграммы больше не являются сводными диаграммами, они являются обычными диаграммами, а их диапазон исходных данных пуст. Исходные данные для Master PivotChart заполняется, но серым цветом, поэтому он не редактируется.

проблема появляется сразу после копирования листа из одной книги в другую (на эту строку: XLMaster.Sheets(SlideRS.Fields(2).Value).Copy After:=XLClinic.Sheets(XLClinic.Sheets.Count)), хотя я включу код для вызова Subs. К тому времени, когда он добирается до этих линий, график уже сломан

вопрос состоит из трех частей:

1. могу ли я предотвратить преобразование сводной диаграммы в обычную диаграмму в копии? т. е. есть флаг/параметр .Copy что я пропустил?
2. если нет, Могу ли я обновить диаграмму, чтобы снова стать сводной диаграммой, что-то вроде cchart.Chart.PivotLayout.PivotTable = mchart.Chart.PivotLayout.PivotTable?
3. при отсутствии любого из них, каков наилучший способ создать сводную диаграмму с нуля в скопированном листе?

Примечания:

1. это стандартные сводные таблицы Excel, я не использую PowerPivot. Я открыт для этого, хотя, если это исправит проблему. только что прочитав немного о PowerPivot, я не думаю, что это поможет мне, но, опять же, я открыт для предложений.
2. в ответ Йенс' комментарий, необработанные данные и Pivot таблицы находятся на одном листе, А ось графика на втором листе.

вот код. Он отлично работает для всего за исключением копирование листа с неповрежденной сводной диаграммой сводная диаграмма.

  While Not SlideRS.EOF                                                   'loop through all the supporting data sheets for this graph sheet
    If SlideRS.Fields(1) <> SlideRS.Fields(2) Then                        'the worksheet depends on something else, copy it first
      If InStr(1, UsedSlides, SlideRS.Fields(2)) = 0 Then                 'if the depended upon slide is not in the list of UsedSlides, then add it
        Form_Master.ProcessStatus.Value = "Processing: " & ClinicName & "  Slide: " & SlideRS!SlideName & "    Worksheet: " & SlideRS.Fields(2).Value
        XLMaster.Sheets(SlideRS.Fields(2).Value).Copy After:=XLClinic.Sheets(XLClinic.Sheets.Count)
        Set NewSheet = XLClinic.Sheets(XLClinic.Sheets.Count)
        UsedSlides = UsedSlides & "," & NewSheet.Name
        UpdateCharts XLMaster.Sheets(SlideRS.Fields(2).Value), NewSheet
        ProcessDataSheet NewSheet, NewXLName
        Set NewSheet = Nothing
      End If
    End If
    SlideRS.MoveNext                                                      'move to the next record of supporting Data sheets
  Wend

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

Private Sub UpdateCharts(ByRef Master As Worksheet, ByRef Clinic As Worksheet)

Dim MChart As Excel.ChartObject
Dim CChart As Excel.ChartObject
Dim Ser As Excel.Series
Dim pnt As Excel.point
Dim i As Integer
Dim Color() As Long
Dim ColorWheel As ChartColors

  Set ColorWheel = New ChartColors
  For Each MChart In Master.ChartObjects
    For Each CChart In Clinic.ChartObjects
      If CChart.Name = MChart.Name Then
        If CChart.Chart.ChartType = xlPie Or _
           CChart.Chart.ChartType = xl3DPie Or _
           CChart.Chart.ChartType = xl3DPieExploded Or _
           CChart.Chart.ChartType = xlPieExploded Or _
           CChart.Chart.ChartType = xlPieOfPie Then
          If InStr(1, CChart.Name, "ColorWheel") Then                  'this pie chart needs to have pre-defined colors assigned
            i = 1
            For Each pnt In CChart.Chart.SeriesCollection(1).Points
              pnt.Format.Fill.ForeColor.RGB = ColorWheel.GetRGB("Pie" & i)
              i = i + 1
            Next
          Else                                                      'just copy the colors from XLMaster
            'collect the colors for each point in the SINGLE series in the MASTER pie chart
            i = 0
            For Each Ser In MChart.Chart.SeriesCollection
              For Each pnt In Ser.Points
                ReDim Preserve Color(i)
                Color(i) = pnt.Format.Fill.ForeColor.RGB
                i = i + 1
              Next 'point
            Next 'series
            'take that collection of colors and apply them to the CLINIC pie chart points
            i = 0
            For Each Ser In CChart.Chart.SeriesCollection
              For Each pnt In Ser.Points
                pnt.Format.Fill.ForeColor.RGB = Color(i)
                i = i + 1
              Next 'point
            Next 'series
          End If
        Else
          'get the series colors from the MASTER
          i = 0
          For Each Ser In MChart.Chart.SeriesCollection
            ReDim Preserve Color(i)
            Color(i) = Ser.Interior.Color
            i = i + 1
          Next 'series
          'assign them to the CLINIC
          i = 0
          For Each Ser In CChart.Chart.SeriesCollection
            Ser.Interior.Color = Color(i)
            i = i + 1
          Next 'series
        End If 'pie chart
      End If 'clinic chart = master chart
    Next 'clinic chart
  Next 'master chart
  Set ColorWheel = Nothing

End Sub

здесь ProcessDataSheet() код. Это позволит обновить данные на листе на основе одного или нескольких SQL-запросов, встроенных в лист.

Private Sub ProcessDataSheet(ByRef NewSheet As Excel.Worksheet, ByRef NewXLName As String)

Const InstCountRow As Integer = 1
Const InstCountCol As Integer = 2
Const InstDataCol As Integer = 2
Const InstCol As Integer = 3
Const ClinicNameParm As String = "{ClinicName}"
Const LikeClinicName As String = "{LikeClinicName}"
Const StartDateParm As String = "{StartDate}"
Const EndDateParm As String = "{EndDate}"
Const LocIDParm As String = "{ClinicLoc}"

Dim Data As New ADODB.Recordset
Dim InstCount As Integer
Dim SQLString As String
Dim Inst As Integer
Dim pt As Excel.PivotTable
Dim Rng As Excel.Range
Dim Formula As String
Dim SChar As Integer
Dim EChar As Integer
Dim Bracket As Integer
Dim TabName As String
Dim RowCol() As String

  'loop through all the instructions on the page and update the appropriate data tables
  InstCount = NewSheet.Cells(InstCountRow, InstCountCol)
  For Inst = 1 To InstCount
    RowCol = Split(NewSheet.Cells(InstCountRow + Inst, InstDataCol), ",")
    SQLString = NewSheet.Cells(InstCountRow + Inst, InstCol)
    SQLString = Replace(SQLString, """", "'")
    If InStr(1, SQLString, LikeClinicName) > 0 Then
      SQLString = Replace(SQLString, LikeClinicName, "'" & ClinicSystoc & "%'")
    Else
      SQLString = Replace(SQLString, ClinicNameParm, "'" & ClinicSystoc & "'")
    End If
    SQLString = Replace(SQLString, LocIDParm, "'" & ClinicLocID & "%'")
    SQLString = Replace(SQLString, StartDateParm, "#" & StartDate & "#")
    SQLString = Replace(SQLString, EndDateParm, "#" & EndDate & "#")
    Data.Open Source:=SQLString, ActiveConnection:=CurrentProject.Connection
    If Not Data.EOF And Not Data.BOF Then
      NewSheet.Cells(CInt(RowCol(0)), CInt(RowCol(1))).CopyFromRecordset Data
    End If
    Data.Close
  Next

  'search for all external sheet refrences and truncate them so it points to *this* worksheet
  Set Rng = NewSheet.Range(NewSheet.Cells.Address).Find(What:=XLMasterFileName, LookIn:=xlFormulas, Lookat:=xlPart, MatchCase:=False)
  While Not Rng Is Nothing
    Formula = Rng.Cells(1, 1).Formula
    If InStr(1, Formula, "'") > 0 Then
      SChar = InStr(1, Formula, "'")
      EChar = InStr(SChar + 1, Formula, "'")
      Bracket = InStr(1, Formula, "]")
      TabName = Mid(Formula, Bracket + 1, EChar - Bracket - 1)
      Rng.Replace What:=Mid(Formula, SChar, EChar - SChar + 1), replacement:=TabName, Lookat:=xlPart
    End If
    Set Rng = NewSheet.Range(NewSheet.Cells.Address).Find(What:=XLMasterFileName, LookIn:=xlFormulas, Lookat:=xlPart, MatchCase:=False)
  Wend
  Set Rng = Nothing

  'fix all the pivot table data sources so they point to *this* spreadsheet
  'TODO: add a filter in here to remove blanks
  'NOTE: do I want to add for all pivots, or only selected ones?
  For Each pt In NewSheet.PivotTables
    Formula = pt.PivotCache.SourceData
    Bracket = InStr(1, Formula, "!")
    Formula = Right(Formula, Len(Formula) - Bracket)
    pt.ChangePivotCache XLClinic.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Formula)
  Next

  SaveNewXL NewXLName         'yes, save the spreadsheet every single time so that the links in the PPT can be updated to point to it.  Sigh...

End Sub

обновление

на основе предложение R3uK, я добавил призыв к началу UpdateCharts Sub, здесь:

  If Master.ChartObjects.Count > 0 Then
    Set ColorWheel = New ChartColors      'only do this if we need to
  End If
  For Each MChart In Master.ChartObjects
    If Not MChart.Chart.PivotLayout Is Nothing Then

      'Re-copy just the pivot chart from Master to Clinic
      CopyPivotChart PivotItemsList, MChart, CChart, Clinic

    End If

С CopyPivotChart здесь:

Private Sub CopydPivotChart(ByVal PivotItemsList As PivotTableItems, ByVal MChart As Excel.ChartObject, ByRef CChart As Excel.ChartObject, ByRef Clinic As Worksheet)

Dim TChart As Excel.ChartObject

'Breakpoint 1
  For Each TChart In Clinic.ChartObjects
    If TChart.Name = MChart.Name Then
      TChart.Delete
    End If
  Next

  MChart.Chart.ChartArea.Copy
'Breakpoint 2
  Clinic.PasteSpecial Format:="Microsoft Office Drawing Object", Link:=False, DisplayAsIcon:=False
  Clinic.PasteSpecial Format:=2

End Sub

когда я запускаю этот код, я получаю

ошибка выполнения '1004': метод PasteSpecial' объекта'_Worksheet' не

на следующей строке Breakpoint 2.

теперь, если я пропущу For Each цикл Breakpoint 1 (вручную перетащите точку выполнения ниже цикла) и вручную удалите диаграмму из рабочего листа Clinic, тогда код выполняется просто отлично.