Question

我在ppt中有一个VBA宏，它从外部excel Spreadsheet获取数据并将其粘贴到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$1:$G$2")
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中调整图表大小

1 个答案: