Linking with powerpoing using VBA
works perfectly thank you so much.
"EricG" wrote:
Recording a macro in PowerPoint gives this for sizing and positioning:
ActiveWindow.Selection.SlideRange.Shapes("AutoShap e 4").Select
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.74, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.79, msoFalse, msoScaleFromBottomRight
End With
With ActiveWindow.Selection.ShapeRange
.IncrementLeft 48#
.IncrementTop -6#
End With
You should be able to do that from Excel by referencing the PPT app,
something like "PPApp.Activewindow.Selection...". A little experimenting
will get you there!
"Emma" wrote:
Hi
I've worked it out :)
Thank you very much for all your help Eric. Now i just need to work out how
to resize the picture :)
Set PPSlide = PPPres.Slides(2)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' Paste the range
PPSlide.Shapes.Paste.Select
' Position pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With
"EricG" wrote:
This version opens an existing PowerPoint file instead of creating a new one,
then adds some slides and selects the second slide. Watch for line wrap in
the code below!
Sub Control_PPT()
Dim PPTApp As PowerPoint.Application
Dim PPres As PowerPoint.Presentation
Dim theSlide As PowerPoint.Slide
Dim PPTFile As Variant
'
PPTFile = Application.GetOpenFilename("PowerPoint Files (*.ppt*),
*.ppt*", , "Select a PowerPoint File to Open", , False)
If (PPTFile = False) Then Exit Sub
'
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = msoTrue
Set PPres = PPTApp.Presentations.Open(PPTFile, msoFalse, , msoTrue)
PPres.Slides.Add Index:=PPres.Slides.Count + 1, Layout:=ppLayoutBlank
PPres.Slides.Add Index:=PPres.Slides.Count + 1, Layout:=ppLayoutBlank
PPres.Slides.Add Index:=PPres.Slides.Count + 1, Layout:=ppLayoutBlank
'
Set theSlide = PPres.Slides(2)
theSlide.Select
'
' Do other stuff here...
'
' Unload the PowerPoint stuff
'
Set theSlide = Nothing
Set PPres = Nothing
Set PPTApp = Nothing
'
End Sub
|