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

这应该可行，但如果没有，请告诉我！

使用每个图形单独大小的Excel VBA图形到Powerpoint

1 个答案: