excel - 使用 VBA 在 Powerpoint 中的 ChartArea 中定位 PlotArea

问题描述

（帖子更新了整个代码，对于初学者的错误感到抱歉）

这里是编码和 VBA 的新手，我正在尝试为演示文稿中的图表调整 PlotArea。我正在从 Excel 运行它。

创建和填充图表很顺利，调整 ChartArea 的大小也没有问题，格式化所有标题等也没有问题。

当图表看起来像我想要的那样，大小正确且位置正确时，我希望 PlotArea 的大小和位置精确。尺寸调整很好，但位置不起作用。

这是我使用的代码，包括使用虚拟数据填充 ChartData 并添加一个红色框以显示我希望 PlotArea 所在的位置：

Sub CreateChart()

'Declare Excel Object Variables
Dim pptWorkBook As Excel.Workbook
Dim pptWorkSheet As Excel.Worksheet

'Declare PowerPoint Object Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim PPTShape As PowerPoint.Shape
Dim PPTChart As PowerPoint.Chart
Dim PPTChartData As PowerPoint.ChartData
Dim SldHeight, SldWidth As Integer
Dim ChrHeight, ChrWidth As Single
Dim PlotHeight, PlotWidth As Double

'Declare Excel Object Variable
Dim ExcRange As Range
    
'Create a new instance of Powerpoint
Set PPTApp = New PowerPoint.Application
    PPTApp.Visible = True

'Create a new Presentation within the Application
Set PPTPres = PPTApp.Presentations.Add

'Disable Snap-To-Grid
PPTPres.SnapToGrid = msoFalse

'Create a new slide within the Presentation
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)

'Find out size (points) of Slide
SldHeight = PPTPres.PageSetup.SlideHeight
SldWidth = PPTPres.PageSetup.SlideWidth

'Calculate Chart and Plot Size
ChrWidth = 954
ChrHeight = 525 - 106
PlotWidth = 866 - 95
PlotHeight = 437 - 106 - 20

'No screen updates
Application.ScreenUpdating = False

'Create a new Chart within the Slide, give it proper size
Set PPTShape = PPTSlide.Shapes.AddChart2(-1, xlColumnClustered, 0, 106, ChrWidth, ChrHeight, True)

'Minimize ChartData
PPTShape.Chart.ChartData.Workbook.Application.WindowState = -4140

'Set chartdata
Set PPTChartData = PPTShape.Chart.ChartData

'Set Workbook object reference
Set pptWorkBook = PPTChartData.Workbook

'Set Worksheet object reference
Set pptWorkSheet = pptWorkBook.Worksheets(1)

'Add Data
pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("A1:B5")
pptWorkSheet.Range("b1").Value = "Items"
pptWorkSheet.Range("a2").Value = "Bikes"
pptWorkSheet.Range("a3").Value = "Accessories"
pptWorkSheet.Range("a4").Value = "Repairs"
pptWorkSheet.Range("a5").Value = "Clothing"
pptWorkSheet.Range("b2").Value = "1000"
pptWorkSheet.Range("b3").Value = "2500"
pptWorkSheet.Range("b4").Value = "4000"
pptWorkSheet.Range("b5").Value = "3000"

 
'Apply Style
With PPTShape.Chart
    .ChartStyle = 4
End With

'Remove title
With PPTShape.Chart
    .HasTitle = False
End With

'Format legend
With PPTShape.Chart
    .HasLegend = True
    .Legend.Position = xlLegendPositionTop
    .Legend.Top = 0
End With

'Add axis title
With PPTShape.Chart.Axes(xlValue)
    .HasTitle = True
    .AxisTitle.Text = "Dollars"
End With

'Remove gridlines
With PPTShape.Chart.Axes(xlValue)
    .HasMajorGridlines = False
    .HasMinorGridlines = False
End With
 
'Add data labels
PPTShape.Chart.ApplyDataLabels

'Set PlotArea position and size
With PPTShape.Chart.PlotArea
    .InsideLeft = 95
    .InsideTop = 20
    .InsideWidth = PlotWidth
    .InsideHeight = PlotHeight
End With

'Adding a red textbox with the same dimensions and position as the PlotArea
With PPTShape.Chart.Shapes.AddTextbox(msoTextOrientationDownward, 95, 20, PlotWidth, PlotHeight)
    .Line.Weight = 2
    .Line.DashStyle = msoLineLongDash
    .Line.ForeColor.RGB = RGB(255, 0, 0)
End With

'Quit
Set pptWorkSheet = Nothing
pptWorkBook.Application.Quit
Set pptWorkBook = Nothing
Set PPTChartData = Nothing
Set PPTChart = Nothing

'Screen updates
Application.ScreenUpdating = True


End Sub

您可以在下面看到带有虚拟数据的结果。红框是正确的，PlotArea 大小正确但位置不正确。我是否误解了有关 InsideLeft 与 Left 属性的内容？我已经被困在这里几个小时了，我没有取得任何进展。我和一位同事的一个理论是，PlotArea 正在对看不见的东西进行 Snap-To。

任何帮助表示赞赏！

更新：我改变了 PlotArea 的定位和大小顺序，它得到了改进。

'Set PlotArea position and size
With PPTShape.Chart.PlotArea
    .InsideWidth = PlotWidth
    .InsideHeight = PlotHeight
    .InsideLeft = 95
    .InsideTop = 20
End With

与红色框的偏移似乎是一致的，我确信这是我在某处遗漏的一件小事。请参阅下面新结果的附图。

标签： excelvbapositionpowerpointshapes

excel - 使用 VBA 在 Powerpoint 中的 ChartArea 中定位 PlotArea

问题描述

解决方案

推荐阅读