I have a powerpoint presentation with 100 slides and most of them have linked excel charts. I am trying to run a macro that will cycle through the slides and then the shapes on the slides and find the linked chart/graph, copy it, and paste it into the same position as a metafile so that I can make an emailable pdf file. However, the macro is skipping over the chart or not recognizing it as a chart. I searched and searched, any help would be much appreciated.
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
This should be cleaner but you can save the copy/paste step if you simply ungroup the chart shape. That'll give you a metafile directly.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.