在ppt中调整图表大小

Question

我在 ppt 中有一个 VBA 宏，它从外部 excel 电子表格中获取数据并将其粘贴到 PPT 中的图表数据电子表格中，并在 PPT 中创建图表。我已设置好所有内容，但我需要调整图表大小以适合整张幻灯片。有没有办法在 PPT VBA 中做到这一点？我在下面粘贴了我的代码。任何帮助将不胜感激。

Public dlgOpen As FileDialog
Public folder As String
Public excelApp As Object
Public xlWorkbook As Excel.Workbook
Public xlWorkBook2 As Excel.Workbook
Public GTChartData As Excel.Workbook
Public PPT As Presentation
Public xlws As Excel.Worksheet
Public xlws2 As Excel.Worksheet
Public GenTotalsChart As Chart

Public Sub GenerateVisual()

Set dlgOpen = Application.FileDialog(Type:=msoFileDialogFolderPicker)

    dlgOpen.Show
    dlgOpen.Title = "Select Report Location"

    folder = dlgOpen.SelectedItems(1)

    Set PPT = ActivePresentation
    Set excelApp = CreateObject("Excel.Application")

    excelApp.Visible = True

Set xlWorkbook = excelApp.workbooks.Open(folder & "\MarketSegmentTotals.xls")
Set xlws = xlWorkbook.Sheets("MarketSegmentTotals")
Set xlWorkBook2 = excelApp.workbooks.Open(folder & "\GeneralTotals.xls")
Set xlws2 = xlWorkBook2.Sheets("Totals")
Set GenTotalsChart = ActivePresentation.Slides(1).Shapes.AddChart.Chart
Set GTChartData = GenTotalsChart.ChartData.Workbook

With GTChartData.ActiveSheet

  .Range("B1").Value = xlws.Range("A1").Value
  .Range("C1").Value = xlws.Range("B1").Value
  .Range("D1").Value = xlws.Range("C1").Value
  .Range("E1").Value = xlws.Range("D1").Value
  .Range("F1").Value = xlws.Range("E1").Value
  .Range("G1").Value = xlws.Range("F1").Value

  .Range("B2").Value = xlws.Range("A2").Value
  .Range("C2").Value = xlws.Range("B2").Value
  .Range("D2").Value = xlws.Range("C2").Value
  .Range("E2").Value = xlws.Range("D2").Value
  .Range("F2").Value = xlws.Range("E2").Value
  .Range("G2").Value = xlws.Range("F2").Value


End With

GTChartData.ActiveSheet.ListObjects("Table1").Resize Range("$A:$G")
GTChartData.ActiveSheet.Range("A2").Clear

With GenTotalsChart
.HasTitle = True
.ChartTitle.Text = "DD Ready by Market Segment"
.HasDataTable = True
.ChartArea.Width = "848"
.ChartArea.Height = "448"
.DataTable.HasBorderHorizontal = False
.DataTable.HasBorderOutline = False
.DataTable.HasBorderVertical = False

End With

'MsgBox (GenTotalsChart.ChartArea.Width)
'MsgBox (GenTotalsChart.ChartArea.Height)







'excelApp.DisplayAlerts = False
'xlWorkbook.Close
'xlWorkBook2.Close
'Application.DisplayAlerts = True
'
'excelApp.Quit


End Sub

Answer 1

GenTotalsChart.Parent 将为您提供包含图表的形状的参考，因此：

With GenTotalsChart.Parent
   .Left = 0
   .Top = 0
   .Width = ActivePresentation.PageSetup.SlideWidth
   .Height = ActivePresentation.PageSetup.SlideHeight
End With

在ppt中调整图表大小

Resize chart in ppt

excel

charts

powerpoint

vba