问Excel更新PowerPoint演示文稿

EN

Option Explicit

Public Sub UpdateShapes()

    Dim vPowerPoint As PowerPoint.Application
    Dim vPresentation As Presentation
    Dim vSlide As Slide

    Dim vShapeName As String
    Dim vShape, vNewShape

    Set vPowerPoint = New PowerPoint.Application
    vPowerPoint.Visible = True

    ' Open the powerpoint presentation
    Set vPresentation = vPowerPoint.Presentations.Open("\\network_folder\presentation.pptm")

    ' Set slide to be worked on
    Set vSlide = vPresentation.Slides(2)

    ' Set shape to (for this example) "Picture 3"
    vShapeName = "Picture 3"
    Set vShape = vSlide.Shapes(vShapeName)

    ' Copy and paste new shape (picture) of range specified
    ThisWorkbook.Sheets("Sheet1").Range("A6:B9").CopyPicture
    Set vNewShape = vSlide.Shapes.Paste

    ' Align size and position of new shape to that of old shape
    With vNewShape
        .Width = vShape.Width
        .Height = vShape.Height
        .Left = vShape.Left
        .Top = vShape.Top
    End With

    ' Delete original shape, rename new shape to original so code works next replace cycle
    vSlide.Shapes(vShapeName).Delete
    vNewShape.Name = vShapeName

End Sub