Скопируйте данные из Excel и вставьте в фоновый лист диаграммы PPT - PullRequest
0 голосов
/ 06 августа 2020

Я пытаюсь вставить данные из моего Excel в фоновый лист диаграммы PPT, я могу вставить их в обычную диаграмму, но когда я пытаюсь развернуть диаграмму в пончике / p ie, появляется ошибка типа «эта член доступен только для объекта диаграммы ". И скажите, пожалуйста, как обновить таблицы в ppt значениями excel. пожалуйста, обнаружите, что приведенный ниже код отлично работает для копирования значений из файла Excel в диаграммы ppt. '' '

Set ObjPPT = CreateObject("PowerPoint.Application")
DestinationPPT = "path" & "PPT_File name.pptm"
Set ObjPresentation = ObjPPT.Presentations.Open(DestinationPPT)

strPath = ThisWorkbook.Sheets("Control").Range("InputFolder").Value
For Each FileName In ThisWorkbook.Sheets("Control").Range("File_Name")
    ' Get variables from Code Sheet
    SheetName = FileName.Offset(0, 1).Value
    SlideNumber = FileName.Offset(0, 2).Value
    ChartName = FileName.Offset(0, 3).Value
    CopyRange = FileName.Offset(0, 4).Value
    PasteRange = FileName.Offset(0, 5).Value
    'Open Source Workbook
    Set wkbSource = Workbooks.Open(strPath & FileName)
    
    Set ObjSlide = ObjPresentation.Slides(SlideNumber)
    'MsgBox ObjSlide.Shapes(ChartName).Chart.ChartType
    Set mychart = ObjSlide.Shapes(ChartName).Chart 'Here I am getting that error which I mentioned above
    'mychart.SeriesCollection(1).DataLabels.NumberFormat = "###"
    'mychart.SeriesCollection(1).DataLabels.Position = xlLabelPositionCenter
    Set pptWkBk = mychart.ChartData.Workbook
    Set pptWSheet = pptWkBk.Worksheets(1)
    'pptWSheet.ListObjects("Table1").Resize pptWSheet.Range(PasteRange)
    
    
    wkbSource.Sheets(SheetName).Range(CopyRange).Copy
    
    pptWSheet.Range(PasteRange).Value = wkbSource.Sheets(SheetName).Range(CopyRange).Value
    pptWSheet.Range("A1:A10000").NumberFormat = "[$-en-US]d-mmm;@"
    wkbSource.Close
    Set wkbSource = Nothing
      
  
Next FileName

Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Done")
End Sub

' ''

...