Question

我有一个包含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

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

在powerpoint中选择链接的Excel图表

1 个答案: