Charts size and position VBA (Excel and ppt 2003)

Topic

New Reply

I have a ppt file with 100 slides. It is liked to an excel file with about 90 chart sheets in it. I have positioned everything in the ppt file the way i want it as far as size and position on the slide. Now I have 10 more ppt files and i don’t want to manually position and size all of them again. They would get sized and positioned just like the one i just finished.

How can I code a macro to go through the first one and save the positioning of each chart on the slide and then use this information for the other reports? Thank you for the help.

Reply | Quote

Replies

Do the slides with charts have other elements such as a title box, or are the charts the sole occupants of those slides?

Reply | Quote

yes, unfortunately there are other elements such as footnote, title, page number. The chart usually sits in the middle of the slide but the “size” of it is different on each slide. There are pies, horiz and vert bar graphs, and stacked bar graphs.

Reply | Quote

Next question: have the other 10 presentations already been populated, i.e. the macro “only” needs to fix the position and size of the charts, or should the macro get the charts from somewhere and place them on the slides?

Reply | Quote

The charts are already in the ppt files.

Reply | Quote

This should do it, hopefully. Don’t forget to substitute the correct names for the presentations. P1.ppt stands for the one where the charts have already been positioned/sized correctly.

Sub FixCharts()
Dim ppt1 As Presentation
Dim ppt2 As Presentation
Dim i As Integer
Dim j As Integer
Dim k As Integer

Set ppt1 = Presentations(“P1.ppt”)
Set ppt2 = Presentations(“P2.ppt”)

For i = 1 To ppt1.Slides.Count
For j = 1 To ppt1.Slides(i).Shapes.Count
If ppt1.Slides(i).Shapes(j).Type = msoLinkedOLEObject Then
For k = 1 To ppt2.Slides(i).Shapes.Count
If ppt2.Slides(i).Shapes(k).Type = msoLinkedOLEObject Then
Exit For
End If
Next k
ppt2.Slides(i).Shapes(k).Top = ppt1.Slides(i).Shapes(j).Top
ppt2.Slides(i).Shapes(k).Left = ppt1.Slides(i).Shapes(j).Left
ppt2.Slides(i).Shapes(k).Height = ppt1.Slides(i).Shapes(j).Height
ppt2.Slides(i).Shapes(k).Width = ppt1.Slides(i).Shapes(j).Width
Exit For
End If
Next j
Next i

Set ppt2 = Nothing
Set ppt1 = Nothing
End Sub

Reply | Quote

wow! woopie, this works wonderfully. Saved me TONS of time. Can’t thank you enough!

Reply | Quote

This works great. I forgot that there are several instances where 2 charts (ole objects) are on the same slide. How can I modify the macro to take that into account? Thank you

Reply | Quote

Take out the Exit For

Reply | Quote

Is there a way to identify the charts? We’d need to be able to determine which chart in the master presentation corresponds to which chart in the target presentation.

Reply | Quote

each chart is named the slide number plus an “A” if there is 1 chart and a “B” if there is a second chart. So if slide 25 has 2 charts they are named 25A and 25B

Reply | Quote

OK, then you can check for those names within the two For … Next loops:

If ppt1.Slides(i).Shapes(j).Type = msoLinkedOLEObject Then
If ppt1.Slides(i).Shapes(j).Name = i & “A” Or ppt1.Slides(i).Shapes(j).Name = i & “B” Then
…
End If
End If

You should be able to work out the details yourself.

Reply | Quote

Hi Hans,

I can’t figure out where to find the “name” of the shape in ppt. I was trying to debug the below but i cannot figure out either in Excel or ppt how I can “see” the name of the chart

Sub MatchSizePositionTemplatePPT()
Dim ppt1 As Presentation
Dim ppt2 As Presentation
Dim i As Integer
Dim j As Integer
Dim k As Integer
‘On Error Resume Next

Set ppt1 = Presentations(“cigarettes.ppt”)
Set ppt2 = Presentations(“yogurt.ppt”)

For i = 1 To ppt1.Slides.Count
For j = 1 To ppt1.Slides(i).Shapes.Count
If ppt1.Slides(i).Shapes(j).Type = msoLinkedOLEObject Then
If ppt1.Slides(i).Shapes(j).Name = i & “A” Or ppt1.Slides(i).Shapes(j).Name = i & “B” Then

For k = 1 To ppt2.Slides(i).Shapes.Count
If ppt2.Slides(i).Shapes(k).Type = msoLinkedOLEObject Then
Exit For
End If
Next k
ppt2.Slides(i).Shapes(k).Top = ppt1.Slides(i).Shapes(j).Top
ppt2.Slides(i).Shapes(k).Left = ppt1.Slides(i).Shapes(j).Left
ppt2.Slides(i).Shapes(k).Height = ppt1.Slides(i).Shapes(j).Height
ppt2.Slides(i).Shapes(k).Width = ppt1.Slides(i).Shapes(j).Width
Exit For
End If
End If
Next j
Next i

Set ppt2 = Nothing
Set ppt1 = Nothing
End Sub

Reply | Quote

I already gave you the way to get the name of a shape: ppt1.Slides(i).Shapes(j).Name

Reply | Quote

Now I’m trying to move the ole object to the back so the text box is in the front on the ppt file. I’ve tried this….

Sub FixCharts()
Dim ppt1 As Presentation
Dim ppt2 As Presentation
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error Resume Next

Set ppt1 = Presentations(“cigarettes.ppt”)
Set ppt2 = Presentations(“Yogurt 2.ppt”)

For i = 1 To ppt1.Slides.Count
For j = 1 To ppt1.Slides(i).Shapes.Count
If ppt1.Slides(i).Shapes(j).Type = msoLinkedOLEObject Then
For k = 1 To ppt2.Slides(i).Shapes.Count
If ppt2.Slides(i).Shapes(k).Type = msoLinkedOLEObject Then
‘ x = ppt2.Slides(i).Shapes(k).Name
‘ MsgBox x
Exit For
End If
Next k
ppt2.Slides(i).Shapes(k).Top = ppt1.Slides(i).Shapes(j).Top
ppt2.Slides(i).Shapes(k).Left = ppt1.Slides(i).Shapes(j).Left
ppt2.Slides(i).Shapes(k).Height = ppt1.Slides(i).Shapes(j).Height
ppt2.Slides(i).Shapes(k).Width = ppt1.Slides(i).Shapes(j).Width
ppt2.Slides(i).Shapes(k).ZOrder msoSendBack

If Not ppt2.Slides(i).Shapes(k + 1) Then
ppt2.Slides(i).Shapes(k + 1).Top = ppt1.Slides(i).Shapes(j + 1).Top
ppt2.Slides(i).Shapes(k + 1).Left = ppt1.Slides(i).Shapes(j + 1).Left
ppt2.Slides(i).Shapes(k + 1).Height = ppt1.Slides(i).Shapes(j + 1).Height
ppt2.Slides(i).Shapes(k + 1).Width = ppt1.Slides(i).Shapes(j + 1).Width

End If

Exit For
End If
Next j
Next i

Set ppt2 = Nothing
Set ppt1 = Nothing

MsgBox (“slides match”)
End Sub

Is there a different method to use because this doesn’t work? Thank you for the help.

Reply | Quote

I don’t understand the line

If Not ppt2.Slides(i).Shapes(k + 1) Then

Normally, you compare two items in an If … Then instruction, here you only have ppt2.Slides(i).Shapes(k + 1).

Reply | Quote

Oh, it’s my backwards way of getting to the 2nd ole object on the slide and positioning it the same as the 2nd object on ppt1

I thought the ppt2.Slides(i).Shapes(k).ZOrder msoSendBack
would send the ole object to the back but it doesn’t. Is there another way to make it go to the back? Right now it is in front of the textbox where the user writes bullet points.

Reply | Quote

ppt2.Slides(i).Shapes(k).ZOrder msoSendBack

should send the object behind all others, but if the text boxes are transparent, you’ll see the object through them, so you may have to set their fill color to whatever is your background color. You could test in the loop whether the shape is of type msoPlaceHolder (the default boxes on a slide) or msoTextBox, and set its fill color. Look up Fill in the VBA help.

Reply | Quote