Replies

sorry, this is entire code

Very long piece of code (8400 characters!) moved to attachment by HansV

Thanks very much. That works great.

Now I am trying to change it to format 3 rows of headers that appear throughout the file. The properly formatted rows are 5:7. I want to search for the word TOTAL in B25-B500 and format the row above and below the found row like rows 5:7.

Have tried this…

Dim rngTC As Range
Dim rngCell As Range

Range(“A1”).Select
On Error Resume Next
Set rngTC = ActiveSheet.Columns(“B25:B500”).SpecialCells(xlCellTypeConstants, 2)

If Not rngTC Is Nothing Then
For Each rngCell In rngTC
If InStr(1, rngCell.Value, “TOTAL”, vbTextCompare) > 0 Then
rngCell.Select

Rows(“5:7”).Select
Selection.Copy
rngCell.EntireRow.Offset(-1, 0).Rows(3).Select
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Next rngCell
End If

This is a tremendous help! thank you very much

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.

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.

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

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

yes, that is what i mean. I don’t know how to dim the chart sheets and loop through them.

ok, thank you very much. I am using this but it is skipping the chart worksheets. How do i specify chart sheets as well as worksheets?

Sub Scale100()
Dim wsh As Worksheet
On Error Resume Next

For Each wsh In ActiveWorkbook.Worksheets
wsh.Select
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 1#, msoTrue
.ScaleWidth 1#, msoTrue
End With
Next wsh
Set wsh = Nothing
MsgBox (“Done”)

End Sub

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

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

The charts are already in the ppt files.

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.

yes, worked perfectly. thanks very much

oh, sorry. I mean the actual chart on the chart sheet. I need to “name” this chart because it gets paste linked into a powerpoint file and I need to access the chart by it’s name in powerpoint.