View Full Version : Copying slides formats vba
ddukee
11-30-2014, 03:20 AM
Hi,
I have such an unusual problem with the Power Point.
On the first slide edited the chart:
a. Resize the chart
b. Change the size and position of the chart title
c. Change the formatting of the X-axis
d. Change the formatting of one of the series
e. Change the formatting of the legend
And now it was about it, to be able to effectively apply these settings to all selected charts en masse. example, point out where I want to make it slide this format and it gets all the graphs in these slides. The graphs generated from each slide platforms has the same elements.
Thanks in advance :)
John Wilson
12-01-2014, 09:16 AM
You will probably have to do some more work but this should get you close
Sub fixChts()
Dim ocht As Chart
Dim oshp As Shape
Dim osld As Slide
Dim sngW As Single
Dim sngH As Single
Dim sngL As Single
Dim sngT As Single
Dim sngTitleL As Single
Dim leg As Legend
On Error Resume Next
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.HasChart Then
sngL = oshp.Left
sngT = oshp.Top
sngW = oshp.Width
sngH = oshp.Height
sngTitleL = oshp.Chart.ChartTitle.Left
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasChart Then
oshp.Left = sngL
oshp.Top = sngT
oshp.Width = sngW
oshp.Height = sngH
Set ocht = oshp.Chart
If ocht.HasTitle Then
ocht.ChartTitle.Left = sngTitleL
With ocht.ChartTitle.Format.TextFrame2.TextRange
.Font.Italic = False
.Font.Size = 16
.ParagraphFormat.Alignment = msoAlignLeft
End With
End If
If ocht.HasLegend Then
Set leg = ocht.Legend
ocht.Legend.Format.Line.Visible = False
End If
End If
Next oshp
Next osld
Else
MsgBox "You do not have a chart selected."
End If
End Sub
ddukee
12-02-2014, 04:58 AM
I used this code and it's ok but I have a problem with the Y axis
Axis value is 120 and I want to on each slide was equal to the value of 100 .
12576
Sub SetLinkedChartSize()
Dim s As Slide
Dim shp As Shape
For Each s In ActivePresentation.Slides
s.Select
For Each shp In s.Shapes
If shp.Type = msoChart Then
shp.Select
With shp
.LockAspectRatio = msoFalse
.Height = 400
.Width = 500
.Chart.Axes(xlCategory).TickLabelPosition = xlLow
End With
shp.Select
Application.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Application.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
End If
Next shp
Next s
End Sub
John Wilson
12-02-2014, 05:27 AM
As I said you will have to do a little more work on it.
I wold guess add in
ocht.Axes(xlValue).MaximumScale = 100
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.