OK, I have found the code I was looking for. If you can produce a snapshot report file then this will extract the EMF images for you and dump them into powerpoint. I havent used this in a while as 2007+ dont seem to support these snapshot reports. This might be of some help to you..... place the code below into a .bas file (make a text file with the code in it and rename the .txt to .bas) then you can import it into Access from the VBA editor.
Cheers
The Frog
'______________________________________________________________________
Attribute VB_Name = "Push_PPT"
Option Compare Database
Option Explicit
Private Declare Function SetupDecompressOrCopyFile _
Lib "setupAPI" _
Alias "SetupDecompressOrCopyFileA" ( _
ByVal SourceFileName As String, _
ByVal TargetFileName As String, _
ByVal CompressionType As Integer) As Long
Private Declare Function GetTempPath _
Lib "kernel32" _
Alias "GetTempPathA" ( _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName _
Lib "kernel32" _
Alias "GetTempFileNameA" ( _
ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function SetEnhMetaFileBits _
Lib "gdi32" ( _
ByVal cbBuffer As Long, _
lpData As Byte) As Long
Private Declare Function OpenClipboard _
Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard _
Lib "user32" () As Long
Private Declare Function GetClipboardData _
Lib "user32" ( _
ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard _
Lib "user32" () As Long
Private Declare Function SetClipboardData _
Lib "user32" ( _
ByVal wFormat As Long, _
ByVal hMem As Long) As Long
Private Const emfSIG = &H464D4520
Private Const emfVER = &H10000
Private Const emfCID = 14
Private Const ppLayoutBlank = 12
Private Const msoTrue = -1
Private Const ppPasteEnhancedMetafile = 2
Private Const ppViewSlide = 1
Private Const msoAlignCenters = 1
Private Const msoAlignMiddles = 4
Private Const msoFileDialogSaveAs = 2
Sub test_1()
Dim TempPath As String 'location of temp directory
Dim SnapFile As String 'the original snapshot
Dim DataFile As String 'the decompressed snapshot
Dim Length As Long 'return value for API calls
Dim Fnum As Long 'to hold freefile number for direct file access
Dim Flen As Long 'length of the file
Dim Fpos As Long 'position in the file
Dim Fsig As Long 'variable for holding EMF signature bytes
Dim Fver As Long 'variable for holding EMF version bytes
Dim Fbyt As Long 'variable for holding EMF byte length
Dim emfStart As Long 'variable for holding the start position of an EMF
Dim bArray(0 To 3) As Byte 'byte array for holding our retreived searches
Dim emfArray() As Byte 'byte array for holding the entire EMF image
Dim Pages As Long 'how many pages in the report
Dim i As Long 'general purpose variable
Dim z As Long 'general purpose variable
Dim h As Long 'memory handle value for clipboard goes here
Dim L As Integer 'for holding left margin value
Dim R As Integer 'right margin value
Dim T As Integer 'top margin value
Dim B As Integer 'bottom margin value
Dim ppApp As Object 'PowerPoint application object
Dim ppPrs As Object 'Powerpoint presentation object
Dim ppSld As Object 'Powerpoint slide object
Dim ppSdg As Object 'Powerpoint SaveAs dialog box
'L = Round(CCur(Left(GetOption("Left Margin"), Len(GetOption("Left Margin")) - 2)) * 100, 1)
'R = Round(CCur(Left(GetOption("Right Margin"), Len(GetOption("Right Margin")) - 2)) * 100, 1)
'T = Round(CCur(Left(GetOption("Top Margin"), Len(GetOption("Top Margin")) - 2)) * 100, 1)
'B = Round(CCur(Left(GetOption("Bottom Margin"), Len(GetOption("Bottom Margin")) - 2)) * 100, 1)
TempPath = Space(256) 'initialise string
Length = GetTempPath(256, TempPath) 'get the path and length
TempPath = Left(TempPath, Length) & Chr(0) 'cleanup the string (null terminated)
SnapFile = Space(256) 'initialise string
Length = GetTempFileName(TempPath, vbNullString, 0, SnapFile) 'get filename
SnapFile = Left(SnapFile, InStr(SnapFile, Chr(0)) - 1) 'cleanup filename
Call Kill(SnapFile) 'kill the temp file the process made
DataFile = Left(SnapFile, Len(SnapFile) - 3) & "emf" 'create the output filename for decompression
DoCmd.OutputTo acOutputReport, _
"Erfüllungsgrad Total nach Kunden", _
"SnapshotFormat(*.snp)", _
SnapFile 'produce the snapshot to SnapFile
SetupDecompressOrCopyFile SnapFile, DataFile, 0& 'decompress SnapFile to DataFile
Call Kill(SnapFile) 'SnapFile no longer needed
Fnum = FreeFile 'get a file access number
Open DataFile For Binary As Fnum 'open the file with the EMF's
Flen = LOF(Fnum) 'store how big the file is
Seek Fnum, Flen - 503 'total number of pages stored here
Get Fnum, , bArray 'get the 4 bytes starting at our position
CopyMemory Pages, bArray(0), 4 'place the bytes into a variable we can use
Seek Fnum, 1 'go back to the start of the file for searching
Fpos = 0 'set start value
Fsig = 0 'set start value
Fver = 0 'set start value
If Pages = 0 Then GoTo Shutdown 'Nothing to push to PowerPoint
Set ppApp = CreateObject("PowerPoint.Application") 'Create the PowerPoint app object we will manipulate
ppApp.Presentations.Add 'Add our presentation we will populate with slides
Set ppPrs = ppApp.Presentations.Item(1) 'Set a reference to our newly made empty presentation
ppApp.Visible = True 'This seems to only work as long as you can see the app
ppApp.ActiveWindow.ViewType = ppViewSlide 'and only if the view is set to this when visible!!! (weird)
For i = 1 To Pages 'for each report page we want an EMF
Do While Fpos < Flen 'do while file position is less than the length of the file
Get Fnum, , bArray 'read 4 bytes
CopyMemory Fsig, bArray(0), 4 'place into a usable variable
If Fsig = emfSIG Then 'compare the value against our EMF signature
Get Fnum, , bArray 'read the next 4 bytes
CopyMemory Fver, bArray(0), 4 'copy the version info to a variable
If Fver = emfVER Then 'check if the signatures match
Get Fnum, , bArray 'read the next 4
...
read more »
