Sizing charts in a presentation

T

T-Casey

Thanks in advance!,

Powerpoint 2003 SP3

I am currently working on a project of roughly 15 new presentations. Each
pres has about 25 slides with paired charts that I would like to have uniform
in size and positioning. I have put together the following routine to do
this, but I am running into a problem I think because the charts that stored
with a magnification other then 100% and I cannot seem to find the right
property or method to correct this.

does anyone have a routine to do this formatting or an answer to correcting
the magnification issue.

Here is my routine:

Function FormatCharts()

On Error GoTo Catch

Dim sRtn As String: sRtn = "AddGoOfficeObjects"
Dim bRetVal As Boolean: bRetVal = False

Dim chartTop As Double
Dim chartLeft As Double
Dim chartHeight As Double
Dim chartWidth As Double
Dim chartareaTop As Double
Dim chartareaLeft As Double
Dim chartareaHeight As Double
Dim chartareaWidth As Double
Dim plotTop As Double
Dim plotLeft As Double
Dim plotHeight As Double
Dim plotWidth As Double

Dim oChart As Graph.Chart
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape

Call Started

If Not Open_Presentation() Then

GoTo Finally

End If

Set oPres = GetCurrPres()

For Each oSlide In oPres.Slides

Select Case oSlide.SlideNumber

Case 5, 6, 7, 8, 10, 14, 15, 16, 17, 25, 26, 27, 28, 30, 31, 32,
33, 34

For Each oShape In oSlide.Shapes

Select Case oShape.Type

Case Is = msoEmbeddedOLEObject

If InStr(oShape.OLEFormat.progID, "MSGraph") Then

Set oChart = oShape.OLEFormat.Object

oChart.Height = 455
oChart.Width = 610

oChart.PlotArea.Top = 10
oChart.PlotArea.Left = 27
oChart.PlotArea.Height = 239
oChart.PlotArea.Width = 385

oShape.LockAspectRatio = msoFalse
oShape.ScaleHeight 0.7, msoFalse,
msoScaleFromTopLeft
oShape.ScaleWidth 0.7, msoFalse,
msoScaleFromTopLeft
oShape.Width =
Application.InchesToPoints(4.66)
oShape.Height =
Application.InchesToPoints(3.12)
oShape.Left =
Application.InchesToPoints(IIf(oShape.Left < (3 * 72), 0.18, 4.8))
oShape.Top = Application.InchesToPoints(1.75)


End If

End Select

Next oShape

Case 9, 12, 22, 23, 29

Case 20, 21

End Select

Next oSlide

TouchAllCarts

'Done
bRetVal = True

GoTo Finally

Catch:

Call PROGRAM_ErrorRoutine(Err.Number, Err.Description, Err.Source, sRtn)

GoTo Finally

Resume Next

Finally:

Call SaveCurrPres
Call CloseCurrPres
Call CloseAllRecordsets
Call CloseConnection

Set oChart = Nothing
Set oPres = Nothing
Set oSlide = Nothing
Set oShape = Nothing

Call Completed

MsgBox "Format Processing has completed", vbOKOnly + vbExclamation,
"Complete!"

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top