Hi,
i'm working on
Sub PowerPointOLEAutomation()
Dim objPPT As Object
Dim Pres As PowerPoint.Presentation
Dim i As Integer
Dim Dave As String
filepath = Sheets("progdata").Cells(133, 2).Value
'creates the PowerPoint Object
Set objPPT = CreateObject("powerpoint.application")
objPPT.Visible = True 'Makes PowerPoint visible
'Adds a blank presentation
Set Pres = objPPT.Presentations.Open( _
FileName:=filepath, ReadOnly:=msoFalse)
'adds a blank slide and paste the chart
i = 0
x = 2
Slide = "Slide2"
picturename = "Picture 1"
For i = 0 To 24
Set Slide = Pres.Slides.Add(x, ppLayoutBlank)
Dave = i
Call UpdateChart(Dave)
objPPT.ActivePresentation.Slides(x).Shapes.Paste
' objPPT.ActivePresentation.Selection.SlideRange.Shapes(picturename).Select
' With ActiveWindow.Selection.ShapeRange
' .Left = -5.12
' .Top = 10.25
' End With
picturename = "Picture " & i + 1
Slide = "Slide" & x
x = x + 1
Next
to move Pictures to power point, it's not what your after, but shows
how to work with another app.
Might be some help?
Good LUck
Ross
Thanks for the advice, but unfortunately, I don't think that Access
works like PowerPoint.
Here's my code:
Private Sub ImportSpreadsheet()
Dim PathToExe As String
Dim Filename As String
Dim retVal As Variant
On Error GoTo error
OpenExcelFile PathToExe, Filename
If PathToExe = "" Then
Exit Sub
End If
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=acSpreadsheetTypeExcel97, _
TableName:="tblExcelImport", _
Filename:=PathToExe, _
HasFieldNames:=True
Dim appX As Excel.Application
Set appX = GetObject(, "Excel.Application.8")
ERROR429:
If Err.Number = 429 Then
Set appX = CreateObject("Excel.Application.8")
End If
appX.Workbooks.Open Filename:=PathToExe, ReadOnly:=True
Dim db As Database
Dim rsExcelImport As recordSet
Set db = CurrentDb()
Set rsExcelImport = db.OpenRecordset("tblExcelImport",
dbOpenDynaset)
Dim MySheet As Worksheet
Dim row
Set MySheet = appX.Workbooks(Filename).Worksheets("Requirements")
row = 1
Dim pic As Shape
rsExcelImport.MoveFirst
Dim i As Integer
i = MySheet.Shapes.count
For Each pic In MySheet.Shapes
With rsExcelImport
.Edit
![Requirement] = pic
.Update
End With
rsExcelImport.MoveNext
Next pic
appX.Quit
Exit Sub
error:
If Err.Number = 429 Then
GoTo ERROR429
End If
Debug.Print "Error #" & Err.Number & ": " & Err.Description
Exit Sub
End Sub
This code does NOT work. I cannot assign pic to ![Requirement] (an
OLE Object field). Is there a way to make the assignment? I want to
copy the pic object to the OLE Field.
