Excel VBA 图表到 Powerpoint，每个图表都有单独的大小

Question

我在 Excel 中有一个表格，其中提到了每个图表的大小。以及名称以及它们在 Excel 中的位置以及它们在 PP 中的位置。

但是我不能使尺寸起作用，以便它们针对每个单独的图形而变化。我尝试了很多不同的方法，但不知道下一步该尝试什么。有人有想法吗？

    Dim newPowerPoint As PowerPoint.Application
    Dim pptSlide As PowerPoint.Slide
    Dim cht As ChartObject
    Dim objPPT As Object
    Set objPPT = CreateObject("PowerPoint.Application")

    Dim pptPres As PowerPoint.Presentation
    Dim activeSlide As PowerPoint.Slide
    Dim ppShape As Object

    Dim x As Integer
    Dim TBCount As Integer

    TBCount = WorksheetFunction.CountA(Sheets("Graph").Range("B:B"))

    Set pptPres = objPPT.Presentations.Open("confid.pptx")
    Set TableBox = Sheets("Graph").ListObjects("Table2")

    For x = 2 To 2 'TBCount

    Sheetofgraph = Sheets("Graph").Range("E" & x).Value
    SelectedObjectname = Sheets("Graph").Range("B" & x).Value
    HightObject = Sheets("Graph").Range("G" & x).Value
    WideObject = Sheets("Graph").Range("H" & x).Value
    LeftObject = Sheets("Graph").Range("I" & x).Value
    TopObject = Sheets("Graph").Range("J" & x).Value
    Slide = Sheets("Graph").Range("F" & x).Value

    Takesheet = Sheets(Sheetofgraph).Activate

    ActiveSheet.ChartObjects(SelectedObjectname).Select
    ActiveChart.ChartArea.Copy

    pptPres.Slides(Slide).Select
    Set pptSlide = pptPres.Slides(objPPT.ActiveWindow.Selection.SlideRange.SlideIndex)
    Set ppShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture, Link:=msoFalse)

    With pptSlide
    ppShape.Select
    Height = HightObject
    Wide = WideObject
    Left = LeftObject
    Top = TopObject

    End With
    next
    End Sub

Answer 1

我想我有你需要的修复:

With pptShape
  .Height = HightObject
  .Wide = WideObject
  .Left = LeftObject
  .Top = TopObject
End With

这应该可以，但如果不行，请告诉我!