Olive77
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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 uFormat As Long) As Long
Private Declare Function CopyEnhMetaFileA Lib "Gdi32" _
(ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "Gdi32" _
(ByVal hdc As Long) As Long
Sub ExportPictureAsEmf()
Dim myEmfFile, Rep As Long
Do
myEmfFile = Application.GetSaveAsFilename("Test", _
"Windows metafile (*.emf),*.emf", , "Exporting ...")
If VarType(myEmfFile) = vbBoolean Then Exit Sub
If Dir$(myEmfFile) <> "" Then
Rep = MsgBox("The file " & myEmfFile & " already exists. " _
& "Would you like to replace it?", vbYesNoCancel + vbQuestion)
If Rep = vbCancel Then Exit Sub
If Rep = vbYes Then
Kill myEmfFile
Exit Do
End If
Else
Exit Do
End If
Loop
If CopyMyEmfFile(ActiveChart, CStr(myEmfFile), xlScreen, xlPicture) = "" Then
MsgBox "Error!", vbCritical
Else
MsgBox "Chart is saved into " & myEmfFile & " ."
End If
End Sub
Private Function CopyMyEmfFile(myObject As Object, _
sFileNameFull As String, Optional iAppearance, _
Optional iFormat, Optional iSize) As String
Const CF_ENHMETAFILE As Long = 14
If TypeName(myObject) <> "Chart" Then
myObject.CopyPicture iAppearance, iFormat
Else
myObject.CopyPicture iAppearance, iFormat, iSize
End If
OpenClipboard 0
If DeleteEnhMetaFile(CopyEnhMetaFileA(GetClipboardData(CF_ENHMETAFILE), sFileNameFull)) = 0 Then
CopyMyEmfFile = ""
Else
CopyMyEmfFile = sFileNameFull
End If
CloseClipboard
End Function
|
Всего записей: 1271 | Зарегистр. 26-12-2002 | Отправлено: 16:54 26-09-2007 | Исправлено: Olive77, 17:04 26-09-2007 |
|
