Add picture into powerpoint

[Albano]

Does anyone know how to import a picture into powerpoint and place it in a specefic slide at a specific location with vbscript.

Thanks,

Albano

 

[mrmovie]

ive got an example in vba

 

[Albano]

Hi mrmovie,

can you post to see if i can convert to vbscript

Thanks

 

[mrmovie]

'this is a script in vba which is contained in a ppt document.
'it opens a excel workbook which has a slide per worksheet
'it creates a ppt slide for each worksheet
'then copies the chart on the worksheet to each ppt slide
'it might help
Sub XlChartPasteSpecial()
On Error Resume Next
Dim xlApp As Object
Dim xlWrkBook As Object
Dim lCurrSlide As Long

Set xlApp = CreateObject("Excel.Application")

' Open the Excel workbook
fileStr = InputBox("please enter path and filename for excel file", "get file name")

Set xlWrkBook = xlApp.Workbooks.Open(fileStr)
counter = 0
counter2 = 0
numWS = xlWrkBook.Worksheets.Count

For i = 1 To numWS
xlWrkBook.Worksheets(i).Select
ActivePresentation.Slides.Add 1, ppLayoutBlank
Next i

For i = 1 To numWS
xlWrkBook.Worksheets(i).Select
strPrintArea = xlWrkBook.Worksheets(i).PageSetup.PrintArea
'MsgBox strPrintArea
xlWrkBook.Worksheets(i).Range(strPrintArea).CopyPicture

counter = counter + 1

ActivePresentation.Slides(counter).Select
lCurrSlide = ActiveWindow.Selection.SlideRange.SlideNumber
ActivePresentation.Slides(lCurrSlide).Shapes.Paste



With ActivePresentation.Slides(lCurrSlide).Shapes.Item(1)
.LockAspectRatio = msoFalse
.Height = 360.5
.Width = 566.75
End With


Set myDocument = ActivePresentation.Slides(lCurrSlide)
myDocument.Shapes.Range.Align msoAlignMiddles, True
myDocument.Shapes.Range.Align msoAlignCenters, True

With ActivePresentation.Slides(lCurrSlide).Shapes.Item(1)
.Top = 67.12
End With
Next i
xlWrkBook.Close (False)
xlApp.Quit
Set xlApp = Nothing
Set xlWrkBook = Nothing
MsgBox "finished"
End Sub

'###########################
'### OR
'SOME OF THIS MIGHT HELP, TAKEN FROM EXCEL
Sub test()
Set ppApp = CreateObject("powerpoint.Application")


numWS = Application.Worksheets.Count
MsgBox numWS



For i = 1 To numWS
Application.Worksheets(i).Select
numCO = Application.Worksheets(i).ChartObjects.Count
For j = 1 To numCO
Application.Worksheets(i).ChartObjects(j).CopyPicture
'call here to ppApp to paste into slide no. counter1
'ppApp.ActivePresentation.Slides.Add 1, ppLayoutBlank

Next j

MsgBox "no. chart objects " & numCO
MsgBox ""
Next i


End Sub

Sub pptbit()
Dim ppApp As Object
Set ppApp = CreateObject("powerpoint.Application")
'MsgBox "test"
x = ppApp.ActivePresentation.Slides.Count
'MsgBox x
ppApp.ActiveWindow.Panes(2).Activate
ppApp.ActivePresentation.Slides(1).Select
ppApp.ActivePresentation.Slides.Add x + 1
'ppApp.ActivePresentation.Slides(1).Layout

End Sub