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
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