在 powerpoint 中选择链接的 excel 图表答案

【问题标题】：Selecting a linked excel chart in powerpoint在 powerpoint 中选择链接的 excel 图表
【发布时间】：2015-02-04 05:33:11
【问题描述】：

我有一个包含 100 张幻灯片的 powerpoint 演示文稿，其中大多数都链接了 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

【问题讨论】：

标签： vba charts powerpoint paste

【解决方案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

【讨论】：