PPT 2007 charts to pictures (emf)

[balumail75]

Hello friends,

Please help me on this vba code.

I am using the following code for changing ppt charts to pictures (emf).

In each slide, there are 5 charts. One chart is in chart placeholder.

If I run the below vba code, the empty chart placeholder appears and some charts are left out. if I again run the same code for 2 to 3 times, it is converting the remaining charts to emf.

Set oSlides = ActiveWindow.Presentation.Slides

For Each oSld In oSlides
Set oShapes = oSld.Shapes

shapecount = oShapes.Count
For j = 1 To shapecount

If oShapes(j).HasChart Then
left1 = oShapes(j).Left
top1 = oShapes(j).Top

oShapes(j).Cut
ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile
Set oShapeRange = ActiveWindow.Selection.ShapeRange
oShapeRange.Left = left1
oShapeRange.Top = top1
End If
Next j
Next oSld

Thanks for your help.

[John Wilson]

This should get you closer
Sub fixCharts()
Dim osld As Slide
Dim i As Integer
Dim sngL As Single
Dim sngT As Single
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
ActiveWindow.View.GotoSlide (osld.SlideIndex)
For i = osld.Shapes.Count To 1 Step -1
If osld.Shapes(i).Type = msoChart Then
sngL = osld.Shapes(i).Left
sngT = osld.Shapes(i).Top
osld.Shapes(i).Cut
With osld.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
.Left = sngL
.Top = sngT
End With
ElseIf osld.Shapes(i).Type = msoPlaceholder Then
If osld.Shapes(i).PlaceholderFormat.ContainedType = msoChart Then
sngL = osld.Shapes(i).Left
sngT = osld.Shapes(i).Top
osld.Shapes(i).Cut
osld.Shapes(osld.Shapes.Count).Select
DoEvents
ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile
End If
End If
Next i
Next osld
End Sub

[balumail75]

It works great. It's a time saving help, as I have around 123 slides (full of charts). Thanks a lot.

Few clarifications.

Is there a difference between "the looping thru' shapes from the first" and "the looping thru' shapes from the last"? Does it affects the position order, if we cut the shapes and paste while looping?

and also, what does the DoEvents do?

Thanks again for your clarification.

[John Wilson]

You should always loop backwards if you cut or delete a shape.

say you have shapes 1 to 6 and cut/delete shape 5
The old shape 6 becomes shape 5 but your code is still looking for shape 6 and won't be happy when it's not there! Looping backwards you would still have shapes 1 to 4. Make sense?

DoEvents is probably not needed here it passes control to the operating system. I meant to delete it. Ditto Dim oshp as Shape it's from an early test.

Worth taking note of how to paste into a placeholder too (it's not obvious Select it and ActiveWindow.View.Paste)

[balumail75]

Thanks for your clarification. It was very usefull for me, as I was trying this for the past 2 days.

It became clear for me.

[Cosmo]

I used the code provided here in a project I was working on, and had to make a few changes ( making the code recursive to handle groups, resetting the Zorder so the pasted item is reset to the original position). Here are my changes:

Option Explicit
Sub fixCharts()
Dim oSld As Slide
Dim i As Integer
Dim oshp As Shape
On Error GoTo errorcode
If Not Application.Presentations.Count > 0 Then
Exit Sub
End If

For Each oSld In ActivePresentation.Slides
ActiveWindow.View.GotoSlide (oSld.SlideIndex)
For i = oSld.Shapes.Count To 1 Step -1
Set oshp = oSld.Shapes(i)
Call processShape(oSld, oshp)
Next i
Next oSld

Exit Sub
errorcode:
Debug.Print "Error fixCharts function - " & Err.Description & " (" & Err.Number & ")"
Resume Next
End Sub
Private Function processShape(oSld As Slide, oshp As Shape) As Boolean
Dim sngL As Single
Dim sngT As Single
Dim oGroupItem As Shape
Dim shpZorder As Integer
On Error GoTo errorcode
If oshp.Type = msoChart Then
sngL = oshp.Left
sngT = oshp.Top
shpZorder = oshp.ZOrderPosition
oshp.Cut
With oSld.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
.Left = sngL
.Top = sngT
' Restore zOrder Position of original shape
While .ZOrderPosition > shpZorder
.ZOrder msoSendBackward
Wend
End With
ElseIf oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoChart Then
sngL = oshp.Left
sngT = oshp.Top
oshp.Cut
oSld.Shapes(oSld.Shapes.Count).Select
DoEvents
ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile
End If

ElseIf oshp.Type = msoGroup Then
' Process each item of group.
Dim x As Integer
Dim shpRng As ShapeRange
Dim groupCount As Integer
groupCount = oshp.GroupItems.Count
For x = groupCount To 1 Step -1
Set oGroupItem = oshp.GroupItems.Item(x)
Call processShape(oSld, oGroupItem)
Next x
End If
Exit Function
errorcode:
Debug.Print "Error processShape function - " & Err.Description & " (" & Err.Number & ")"
Resume Next
End Function

[balumail75]

Hello John,

In some ppt decks 2007, when the placeholder chart is cut, there is no layout placeholder appearing (which the code "oSld.Shapes(oSld.Shapes.Count).Select") will select and delete.

For testing, if we apply "Title and Content" Layout, the chart is converted to placeholder.

In 2007, If we apply "Title and Content" and insert chart via placeholder.
If we cut the chart and delete the placeholder and then paste the chart.

In the immediate window, if we find the shape type, it is showing as placeholder.

b'cos of this, once there are multiple charts in a same slide, it selected the previous chart and deleted.

Please help on this.

Regards,
Balumail75.