PowerPointのスライドをemf形式で保存

Const CF_ENHMETAFILE = 14
Private Declare Function OpenClipboard Lib "user32" (ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As Long

Sub clip2emf()
Dim hSrcMetaFile As Long
Dim hFileMetaFile As Long
Dim myPresentation As Presentation
Dim mySlide As Slide
Dim i As Long

Set myPresentation = ActivePresentation
i = 1
For Each mySlide In myPresentation.Slides
mySlide.Copy
If OpenClipboard(0) Then
hSrcMetaFile = GetClipboardData(CF_ENHMETAFILE)
hSrcMetaFile = CopyEnhMetaFile(hSrcMetaFile, vbNullString)
CloseClipboard
End If
If hSrcMetaFile = 0 Then
MsgBox "emf取得に失敗"
Exit Sub
End If
hFileMetaFile = CopyEnhMetaFile(hSrcMetaFile, "c:\test" & CStr(i) & ".emf")
DeleteEnhMetaFile hFileMetaFile
DeleteEnhMetaFile hSrcMetaFile
i = i + 1
Next mySlide
End Sub