在 PowerPoint 中选择链接的 excel 图表

Selecting a linked excel chart in powerpoint

我有一个包含 100 张幻灯片的 powerpoint 演示文稿,其中大部分都链接了 excel 个图表。我正在尝试 运行 一个宏,它将循环浏览幻灯片,然后是幻灯片上的形状,并找到链接的 chart/graph,复制它,并将其粘贴到与图元文件相同的位置,这样我可以制作可通过电子邮件发送的 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

这应该更清晰,但如果您只是取消图表形状的组合,则可以节省 copy/paste 步骤。那会直接给你一个图元文件。

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