在Powerpoint中选择链接的Excel图表

Question

我有一张简报，其中包含100张幻灯片，其中大多数都链接了excel图表。 我正在尝试运行一个宏，该宏将遍历幻灯片，然后遍历幻灯片上的形状，并找到链接的图表/图形，将其复制并粘贴到与图元文件相同的位置，以便可以制作可通过电子邮件发送的pdf文件。 但是，宏正在跳过图表或没有将其识别为图表。 我搜寻了，任何帮助将不胜感激。

Sub Select_All()
    Dim oPresentation As Presentation
    Set oPresentation = ActivePresentation

    Dim oSlide As Slide
    Dim oSlides As SlideRange
    Dim oShape As Shape
    Dim slideNumber As Integer
    Dim shapeNumber As Integer
    Dim lastslideNumber As Integer
    Dim lastshapeNumber As Integer, i As Integer
    Dim w As Double
    Dim h As Double
    Dim l As Double
    Dim t As Double

    For slideNumber = 14 To 100

        oPresentation.Slides(slideNumber).Select

        For i = 1 To oPresentation.Slides(slideNumber).Shapes.Count
            If oPresentation.Slides(slideNumber).Shapes(i).HasChart Then
                oPresentation.Slides(slideNumber).Shapes(i).Select
                oPresentation.Slides(slideNumber).Shapes(i).Copy
                With ActiveWindow.Selection.ShapeRange(1)
                    w = .Width
                    h = .Height
                    l = .Left
                    t = .Top
                End With
                oPresentation.Slides(slideNumber).Shapes(i).Delete
                oPresentation.Slides(slideNumber).Shapes.PasteSpecial (ppPasteEnhancedMetafile)

                With ActiveWindow.Selection.ShapeRange
                    '.Width = w
                    '.Height = h
                    .Left = l
                    .Top = t
                    .ZOrder msoSendToBack
                End With
            End If

        Next i

    Next slideNumber

End Sub

Answer 1

这应该更干净一些，但是如果您只是取消图表形状的分组，则可以保存复制/粘贴步骤。 这将直接为您提供一个图元文件。

Sub Select_All() 
Dim oPresentation As Presentation 
Set oPresentation = ActivePresentation

Dim oSlide As Slide
Dim oSlides As SlideRange
Dim oShape As Shape
' These should be Longs
Dim slideNumber As Long
Dim shapeNumber As Long
Dim lastslideNumber As Long
Dim lastshapeNumber As Long 
Dim i As Long

Dim w As Double
Dim h As Double
Dim l As Double
Dim t As Double

For slideNumber = 14 To 100

    'oPresentation.Slides(slideNumber).Select
    ' never select anything unless you absolutely must
    Set oSlide = oPresentation.Slides(slidenumber)

    For i = oSlide.Shapes.Count to 1 step -1
    ' Step through shapes backward, else you'll run into weird 
    ' side effects when deleting shapes
        If oSlide.Shapes(i).HasChart Then
            'oPresentation.Slides(slideNumber).Shapes(i).Select
            ' don't select anything etc etc
            oSlide.Shapes(i).Copy
            With oSlide.Shapes(i)
                w = .Width
                h = .Height
                l = .Left
                t = .Top
          End With
          oSlide.Shapes(i).Delete
          set oShape = oSlide.Shapes.PasteSpecial (ppPasteEnhancedMetafile)(1)

            With oShape
                '.Width = w
                '.Height = h
                .Left = l
                .Top = t
                .ZOrder msoSendToBack
            End With
        End If

    Next i

Next slideNumber