makro za otvaranje postojece ppt prezentacije +....
Pozdrav !
trebam excel makro koji ce selektirati odredjeni range na sheetu "Sheet1", otvoriti postojecu .ppt prezentaciju (koja je negdje na disku),pozicionirati se na "Slide1", paste-ati selektirani range kao enhanced metafile (.emf) i vratiti se u excel na "sheet1".
trenutno imam neki makro koji to radi sa vec otvorenim slideom u vec otovrenoj ppt prezentaciji (to ne zelim, zelim da sam otvori onu koju mu zadam kroz makro):
Sub RangeToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
' Make sure a range is selected
If Not TypeName(Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again.", vbExclamation, _
"No Range Selected"
Else
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
' Copy the range as a piicture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Paste the range
PPSlide.Shapes.Paste.Select
' Align the pasted range
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1, msoFalse, msoScaleFromTopLeft
' Position pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Left = 250
PPApp.ActiveWindow.Selection.ShapeRange.Top = 50
End If
End Sub
Hvala !!!!
 |  |
 |
